Worksheet consolidation VBA

T

Teeks2k

New Member
Joined
Aug 1, 2017
Messages
20
Hello,

I am trying to consolidate 4 worksheets into 1. The problem I am running into is that I am trying to add values to cells based on what is ported over from a specific sheet, when I try it the values I am adding just overwrite each other.

Code: 
Sub FN_Upload()
Dim wksDst As Worksheet
Dim rngSrc As Range, rngDst As Range
Dim SrcLR As Long, DstLR As Long, i As Long
Dim tmp As String

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

Set wksDst = Sheets("FN_Upload")
DstLR = wksDst.Range("D" & Rows.Count).End(xlUp).Row
Set rngDst = wksDst.Cells(DstLR + 1, 4)

With Sheets("Add NNPD")
    SrcLR = .Range("A" & Rows.Count).End(xlUp).Row
    Set rngSrc = .Range(.Cells(2, 1), .Cells(SrcLR, 1))
    For i = 1 To SrcLR
        rngSrc.Copy Destination:=rngDst
    Next i
End With
    For i = 1 To DstLR
        If rngDst > 0 Then
            wksDst.Range("A" & i + 1).Value = "ADD"
            wksDst.Range("B" & i + 1).Value = 10488
            wksDst.Range("C" & i + 1).Value = 3
            wksDst.Range("E" & i + 1).Value = 1
            wksDst.Range("F" & i + 1).Value = 3
        End If
    Next i
    
DstLR = wksDst.Range("D" & Rows.Count).End(xlUp).Row
Set rngDst = wksDst.Cells(DstLR + 1, 4)

With Sheets("Add NPDL")
    SrcLR = .Range("A" & Rows.Count).End(xlUp).Row
    Set rngSrc = .Range(.Cells(2, 1), .Cells(SrcLR, 1))
    
    For i = 1 To SrcLR
    rngSrc.Copy Destination:=rngDst
    Next i
End With
    For i = 1 To DstLR
        If rngDst > 0 Then
            wksDst.Range("A" & i + 1).Value = "ADD"
            wksDst.Range("B" & i + 1).Value = 10488
            wksDst.Range("C" & i + 1).Value = 3
            wksDst.Range("E" & i + 1).Value = 1
            wksDst.Range("F" & i + 1).Value = 2
        End If
    Next i
    

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub


For instance, I have 2 sheets:

Delete:
[TABLE="class: grid, width: 100"]
<tbody>[TR]
[TD]NDC[/TD]
[/TR]
[TR]
[TD][TABLE="width: 137"]
<tbody>[TR]
[TD]24338002010[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][TABLE="width: 137"]
<tbody>[TR]
[TD]24338002110[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][TABLE="width: 137"]
<tbody>[TR]
[TD]31722020090[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][TABLE="width: 137"]
<tbody>[TR]
[TD]31722020190[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][TABLE="width: 137"]
<tbody>[TR]
[TD]31722020290[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]


Add:

[TABLE="class: grid, width: 100"]
<tbody>[TR]
[TD][TABLE="width: 160"]
<tbody>[TR]
[TD]NDC[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][TABLE="width: 160"]
<tbody>[TR]
[TD]00168013915[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][TABLE="width: 160"]
<tbody>[TR]
[TD]00168013930[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][TABLE="width: 160"]
<tbody>[TR]
[TD]00168013960[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][TABLE="width: 160"]
<tbody>[TR]
[TD]45802058001[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]

What I want on the consolidated sheet:

[TABLE="class: grid, width: 200"]
<tbody>[TR]
[TD]Action[/TD]
[TD]NDC[/TD]
[/TR]
[TR]
[TD]DEL[/TD]
[TD][TABLE="width: 137"]
<tbody>[TR]
[TD]24338002010[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]DEL[/TD]
[TD][TABLE="width: 137"]
<tbody>[TR]
[TD]24338002110[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]DEL[/TD]
[TD][TABLE="width: 137"]
<tbody>[TR]
[TD]31722020090[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]DEL[/TD]
[TD][TABLE="width: 137"]
<tbody>[TR]
[TD]31722020190[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]DEL[/TD]
[TD][TABLE="width: 137"]
<tbody>[TR]
[TD]31722020290[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]ADD[/TD]
[TD][TABLE="width: 160"]
<tbody>[TR]
[TD]00168013915[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]ADD[/TD]
[TD][TABLE="width: 160"]
<tbody>[TR]
[TD]00168013930[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]ADD[/TD]
[TD][TABLE="width: 160"]
<tbody>[TR]
[TD]00168013960[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]ADD[/TD]
[TD][TABLE="width: 160"]
<tbody>[TR]
[TD]45802058001[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Sort by date Sort by votes
Is this what you're after
Code: 
Sub FN_Upload()
Dim wksDst As Worksheet
Dim rngSrc As Range, rngDst As Range
Dim SrcLR As Long, DstLR As Long, i As Long
Dim tmp As String

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

Set wksDst = Sheets("FN_Upload")
DstLR = wksDst.Range("D" & Rows.Count).End(xlUp).Row
Set rngDst = wksDst.Cells(DstLR + 1, 4)

With Sheets("Add NNPD")
    SrcLR = .Range("A" & Rows.Count).End(xlUp).Row
    Set rngSrc = .Range(.Cells(2, 1), .Cells(SrcLR, 1))
    rngSrc.Copy Destination:=rngDst
End With
    For i = DstLR + 1 To SrcLR
        If rngDst > 0 Then
            wksDst.Range("A" & i).Value = "ADD"
            wksDst.Range("B" & i).Value = 10488
            wksDst.Range("C" & i).Value = 3
            wksDst.Range("E" & i).Value = 1
            wksDst.Range("F" & i).Value = 3
        End If
    Next i
    
DstLR = wksDst.Range("D" & Rows.Count).End(xlUp).Row
Set rngDst = wksDst.Cells(DstLR + 1, 4)

With Sheets("Add NPDL")
    SrcLR = .Range("A" & Rows.Count).End(xlUp).Row
    Set rngSrc = .Range(.Cells(2, 1), .Cells(SrcLR, 1))
    rngSrc.Copy Destination:=rngDst
End With
    For i = DstLR + 1 To DstLR + SrcLR - 1
        If rngDst > 0 Then
            wksDst.Range("A" & i).Value = "ADD"
            wksDst.Range("B" & i).Value = 10488
            wksDst.Range("C" & i).Value = 3
            wksDst.Range("E" & i).Value = 1
            wksDst.Range("F" & i).Value = 2
        End If
    Next i
    

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub
 
Upvote 0
I decided to use a Do Until loop instead, which made it a lot easier and much faster. Here is the Code snippet from the same section as above

Code: 
Sub FN_Upload()
Dim wksDst As Worksheet, FN_Upload As Worksheet
Dim rngSrc As Range, rngDst As Range
Dim SrcLR As Long, DstLR As Long, x As Long

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

'// FN_Upload Formatting

    Set FN_Upload = ThisWorkbook.Sheets.Add(After:= _
        ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        FN_Upload.Name = "FN_Upload"

    With ThisWorkbook.Sheets("FN_Upload")
        .Cells(1, 1).Value = "ACTION"
        .Cells(1, 2).Value = "FORMULARY_ID"
        .Cells(1, 3).Value = "FORMULARY_VERSION"
        .Cells(1, 4).Value = "NDC"
        .Cells(1, 5).Value = "Drug Name"
        .Cells(1, 6).Value = "COVERAGELEVEL"
        .Cells(1, 7).Value = "FORMULARY_TIER"
        .Cells(1, 8).Value = "USER_NOTE_5"    
    End With

Set wksDst = ThisWorkbook.Sheets("FN_Upload")

'// Add NNPD
DstLR = wksDst.Range("D" & Rows.Count).End(xlUp).Row
Set rngDst = wksDst.Cells(DstLR + 1, 4)

With ThisWorkbook.Sheets("Add NNPD")
    SrcLR = .Range("A" & Rows.Count).End(xlUp).Row
    Set rngSrc = .Range(.Cells(2, 1), .Cells(SrcLR, 2))
    rngSrc.Copy Destination:=rngDst
End With

x = 2
    
With ThisWorkbook.Sheets("FN_Upload")
    Do Until .Cells(x, 4).Value = ""
        .Cells(x, 1).Value = "ADD"
        .Cells(x, 2).Value = 10488
        .Cells(x, 3).Value = 3
        .Cells(x, 6).Value = 1
        .Cells(x, 7).Value = 3
            
            x = x + 1
    Loop
End With

'// Add NPDL
DstLR = wksDst.Range("D" & Rows.Count).End(xlUp).Row
Set rngDst = wksDst.Cells(DstLR + 1, 4)

With ThisWorkbook.Sheets("Add NPDL")
    SrcLR = .Range("A" & Rows.Count).End(xlUp).Row
    Set rngSrc = .Range(.Cells(2, 1), .Cells(SrcLR, 2))
    rngSrc.Copy Destination:=rngDst
End With

x = DstLR + 1
    
With ThisWorkbook.Sheets("FN_Upload")
    Do Until .Cells(x, 4).Value = ""
        .Cells(x, 1).Value = "ADD"
        .Cells(x, 2).Value = 10488
        .Cells(x, 3).Value = 3
        .Cells(x, 6).Value = 1
        .Cells(x, 7).Value = 2
            
            x = x + 1
    Loop
End With
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
Consolidate Total From Multiple Worksheets to Main Worksheet
Replies
6
Views
397
Alex Blakenburg
A
C
  • Question Question
Using pattern searches with a variable to find the correct values
2
Replies
10
Views
266
chazrab
C
M
  • Solved
vba to sum up each column for each employee on column (A)
Replies
6
Views
341
kvsrinivasamurthy
K
B
  • Solved
add a border to bottom of a row
Replies
4
Views
97
bdt
B
P
  • Question Question
Pulling data from a workbook with a different sheet name
Replies
0
Views
633
pragmatic123
P

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

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