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

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
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
385
Alex Blakenburg
A
M
  • Solved
vba to sum up each column for each employee on column (A)
Replies
6
Views
298
kvsrinivasamurthy
K
P
  • Question Question
Pulling data from a workbook with a different sheet name
Replies
0
Views
623
pragmatic123
P
P
  • Question Question
Pull Data from multiple workbooks and transpose data side by side
Replies
0
Views
663
pragmatic123
P
I
  • Question Question
Add button to increment textbox value by 1
2
Replies
13
Views
629
Artik
Artik

Forum statistics

Threads
1,223,227
Messages
6,170,849
Members
452,361
Latest member
d3ad3y3

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