Worksheet consolidation VBA

[Teeks2k]

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.

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:

NDC

24338002010 <tbody> </tbody><colgroup><col></colgroup>

24338002110 <tbody> </tbody><colgroup><col></colgroup>

31722020090 <tbody> </tbody><colgroup><col></colgroup>

31722020190 <tbody> </tbody><colgroup><col></colgroup>

31722020290 <tbody> </tbody><colgroup><col></colgroup>

<tbody>
</tbody>

Add:

NDC <tbody> </tbody><colgroup><col></colgroup>

00168013915 <tbody> </tbody><colgroup><col></colgroup>

00168013930 <tbody> </tbody><colgroup><col></colgroup>

00168013960 <tbody> </tbody><colgroup><col></colgroup>

45802058001 <tbody> </tbody><colgroup><col></colgroup>

<tbody>
</tbody>

What I want on the consolidated sheet:

Action	NDC
DEL	24338002010 <tbody> </tbody><colgroup><col></colgroup>
DEL	24338002110 <tbody> </tbody><colgroup><col></colgroup>
DEL	31722020090 <tbody> </tbody><colgroup><col></colgroup>
DEL	31722020190 <tbody> </tbody><colgroup><col></colgroup>
DEL	31722020290 <tbody> </tbody><colgroup><col></colgroup>
ADD	00168013915 <tbody> </tbody><colgroup><col></colgroup>
ADD	00168013930 <tbody> </tbody><colgroup><col></colgroup>
ADD	00168013960 <tbody> </tbody><colgroup><col></colgroup>
ADD	45802058001 <tbody> </tbody><colgroup><col></colgroup>

<tbody>
</tbody>

 

[Fluff]

Is this what you're after

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

 

[Teeks2k]

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

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

 

[Fluff]

Glad you got it sorted