Editing a 4th column to the same VBA code

kholden1

New Member
Joined
Jun 8, 2023
Messages
16
Office Version
  1. 365
  2. 2007
Platform
  1. Windows
Good morning! I wanted to see if someone could help me modify this VBA code. As it is now, I have 3 columns that search for duplicates, consolidate, and then add the total qty.

I only want to add a 4th column with initials at the end.

Part NumberManufacturerQTY
1234ASONY50
1234ASONY150
1234BON15000
1234CNEW99000

VBA Code:
Sub Consolidate()

Dim ws1 As Worksheet

Dim ws2 As Worksheet

Dim lrow As Long

Dim i As Long



Set ws1 = ActiveSheet

Set ws2 = ActiveWorkbook.Worksheets.Add

ws2.Name = "ONLINEINV3"



lrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row





ws1.Range("A1:B" & lrow).Copy ws2.Range("A1")





ws2.Range("A:B").RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes

ws2.Range("C1") = "FULL PARTNO"

ws2.Range("D1") = "QTY"



lrow = ws2.Cells(Rows.Count, 1).End(xlUp).Row



For i = 2 To lrow

ws2.Cells(i, 3) = ws2.Cells(i, 2) & " " & ws2.Cells(i, 1)

ws2.Cells(i, 4) = Application.SumIfs(ws1.Range("C:C"), ws1.Range("A:A"), ws2.Cells(i, 1), ws1.Range("B:B"), ws2.Cells(i, 2))





Next i



End Sub

This is my current VBA code for the sample spreadsheet above. My new edit would look like this:

Part numberManufacturerQtyComments
1234ASONY50AK02
1234ASONY150AK02
1234BON15000RC03
1234CNEW99000WB01

Please let me know if this is enough information! Thank you all!
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Hi,

As per my understanding and basic knowledge :

  • A Simple Formula we can use : =IF(B2="SONY","AK02",IF(B2="ON","RC03",IF(B2="NEW","WB01")))
OR else

  • Apply the code in the same sheet and run :

VBA Code:
Sub if_then()

   For Each manufec In Range("B:B")
      If manufec = "SONY" Then
         manufec.Offset(0, 2).Value = "AK02"

      ElseIf manufec = "ON" Then
         manufec.Offset(0, 2).Value = "RC03"
        
      ElseIf manufec = "NEW" Then
         manufec.Offset(0, 2).Value = "WB01"

      End If

   Next manufec
   MsgBox "Operation Done"

End Sub
 
Upvote 0
Unfortunately, the initials may be different. They won't always be the same. I could have the same part and manufacturer but different initials or people with that line item.

Part numberManufacturerQTYInitials
1234ASONY150AK02
1234ASONY450RC03


I think my problem is here

VBA Code:
ws2.Range("A:B").RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes

ws2.Range("C1") = "FULL PARTNO"

ws2.Range("D1") = "QTY"



lrow = ws2.Cells(Rows.Count, 1).End(xlUp).Row



For i = 2 To lrow

ws2.Cells(i, 3) = ws2.Cells(i, 2) & " " & ws2.Cells(i, 1)

ws2.Cells(i, 4) = Application.SumIfs(ws1.Range("C:C"), ws1.Range("A:A"), ws2.Cells(i, 1), ws1.Range("B:B"), ws2.Cells(i, 2))

I THINK I would need a
VBA Code:
ws2.Range("E1") = "INITIALS"

lrow = ws2.Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To lrow

ws2.Cells(i, 3) = ws2.Cells(i, 2) & " " & ws2.Cells(i, 1) 

ws2.Cells(i, 4) = Application.SumIfs( ws1.Range("D:D), ws1.Range("C:C"), ws1.Range("A:A"), ws2.Cells(i, 1), ws1.Range("B:B"), ws2.Cells(i, 2))
everything I've tried to edit comes back with a debug.
 
Upvote 0
Unfortunately, the initials may be different. They won't always be the same. I could have the same part and manufacturer but different initials or people with that line item.

Part numberManufacturerQTYInitials
1234ASONY150AK02
1234ASONY450RC03


I think my problem is here

VBA Code:
ws2.Range("A:B").RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes

ws2.Range("C1") = "FULL PARTNO"

ws2.Range("D1") = "QTY"



lrow = ws2.Cells(Rows.Count, 1).End(xlUp).Row



For i = 2 To lrow

ws2.Cells(i, 3) = ws2.Cells(i, 2) & " " & ws2.Cells(i, 1)

ws2.Cells(i, 4) = Application.SumIfs(ws1.Range("C:C"), ws1.Range("A:A"), ws2.Cells(i, 1), ws1.Range("B:B"), ws2.Cells(i, 2))

I THINK I would need a
VBA Code:
ws2.Range("E1") = "INITIALS"

lrow = ws2.Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To lrow

ws2.Cells(i, 3) = ws2.Cells(i, 2) & " " & ws2.Cells(i, 1)

ws2.Cells(i, 4) = Application.SumIfs( ws1.Range("D:D), ws1.Range("C:C"), ws1.Range("A:A"), ws2.Cells(i, 1), ws1.Range("B:B"), ws2.Cells(i, 2))
everything I've tried to edit comes back with a debug.

How you are generating the initials? Is there any specific pattern you are following ?
 
Upvote 0
How you are generating the initials? Is there any specific pattern you are following ?
It's generated from an SQL server. Once a day I pull the report and upload it to a partner's CRM. We could have the same person with the same part and manufacturer from a different company that wouldn't be shown on my report though. My lists are too long for some import software so I was hoping that I could find a way to consolidate this list as I do for the one above. It saves me 50,000+ lines a day doing it with the VBA code. I just can't figure out how to add the initials column. I'd think adding an extra column wouldn't be too difficult since the original VBA is simple but I've proved myself wrong today lol
 
Upvote 0
A reminder:

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at:

There is no need to repeat the link(s) provided above but if you have posted the question at other places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.
 
Upvote 0

Forum statistics

Threads
1,223,893
Messages
6,175,240
Members
452,621
Latest member
Laura_PinksBTHFT

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top