0

I am still newer to VBA and have been trying everything I can think of to get this accomplished before asking for help, but cannot figure it out.

I have an excel file with multiple tabs. I am only concerned with 2 of them. I need to combine rows based off of their values not being blank from tab "Roadmap" into column B on tab "PPPP". The code I have will do that for the first set of data, but then replaces that data with the second set.

Sub Move_PPPP()

Sheets("PPPP").Select
Rows("2:1000").Select
Selection.ClearContents

Dim rowCount2 As Long, shtSrc As Worksheet
Dim shtDest As Worksheet
Dim rng2 As Range
Dim currentRow As Long

    Set shtSrc = Sheets("Roadmap")
    Set shtDest = Sheets("PPPP")

    rowCount2 = shtSrc.Cells(Rows.Count, "C").End(xlUp).Row

    Set rng2 = shtSrc.Range("C6:C" & rowCount2)

    currentRow = 2

        For Each cell2 In rng2.Cells
        If cell2.Value <> "" Then

       shtDest.Range("B" & currentRow).Value2 = "           " & cell2.Text & " - " & cell2.Offset(0, 10).Text
       shtDest.Range("B" & currentRow).Value2 = "           " & cell2.Text & " - " & cell2.Offset(0, 11).Text
       shtDest.Range("B" & currentRow).Value2 = "           " & cell2.Text & " - " & cell2.Offset(0, 12).Text
          currentRow = currentRow + 1

        ElseIf cell2.Value = "" Then

        End If
        Next cell2

End Sub

I have tried to add a range for my destination sheet, but doing that is only giving me 9 rows of the last row of data from tab "Roadmap"

Sub Move_PPPP()

Sheets("PPPP").Select
Rows("2:1000").Select
Selection.ClearContents

Dim rowCount2 As Long, shtSrc As Worksheet
Dim columnCount As Long
Dim shtDest As Worksheet
Dim rng2 As Range
Dim rng As Range
Dim currentRow As Long

    Set shtSrc = Sheets("Roadmap")
    Set shtDest = Sheets("PPPP")

    rowCount2 = shtSrc.Cells(Rows.Count, "C").End(xlUp).Row
    columnCount = shtDest.Cells(Columns.Count, "B").End(xlUp).Row

    Set rng2 = shtSrc.Range("C6:C" & rowCount2)
    Set rng = shtDest.Range("B2:B" & columnCount & currentRow)

    currentRow = 2

        For Each cell2 In rng2.Cells
        If cell2.Value <> "" Then

        rng.Value = "           " & cell2.Text & " - " & cell2.Offset(0, 10).Text

            currentRow = currentRow + 1

        ElseIf cell2.Value = "" Then

        End If
        Next cell2


End Sub

Sample Data

Roadmap Tab

Column: C D E F G H I J K L M Headers: Project Status Open Closed Name P1 P2 P3 P4 P5 P6

Row 1: FISMA New Yes No Albert na na na na New Day Old Data Row 2: QRD Closed No Yes Albert na na na na na Closed

Desired Outcome. Combine Column C with Column M when M <> blank, loop through entire row and put that data in column B of PPPP tab. Then combine column C with N when N <> blank and put that on PPPP tab, column B under the data from column M.

PPPP Tab

Cell B2 FISMA - New Day

Cell B4 FISMA - Old Data QRD - Closed

SOLUTION:

Sub Move_PPPP()

Sheets("PPPP").Select
Rows("2:1000").Select
Selection.ClearContents

Dim rowCount2 As Long, shtSrc As Worksheet
Dim shtDest As Worksheet
Dim rng2 As Range
Dim currentRow As Long

    Set shtSrc = Sheets("Roadmap")
    Set shtDest = Sheets("PPPP")

    rowCount2 = shtSrc.Cells(Rows.Count, "C").End(xlUp).Row

    Set rng2 = shtSrc.Range("C6:C" & rowCount2)

    currentRow = shtDest.Range("A" & Rows.Count).End(xlUp).Row

        For Each cell2 In rng2.Cells
        If cell2.Value2 <> "" Then
        shtDest.Range("A" & currentRow).Value2 = "           " & cell2.Text & " - " & cell2.Offset(0, 9).Text
        currentRow = currentRow + 1

        ElseIf cell2.Value = "" Then

        End If
        Next cell2

    Set rng2 = shtSrc.Range("C6:C" & rowCount2)

    currentRow = shtDest.Range("A" & Rows.Count).End(xlUp).Row + 1

       For Each cell2 In rng2.Cells
       If cell2.Value2 <> ""  Then
       shtDest.Range("A" & currentRow + 1).Value2 = "           " & cell2.Text & " - " & cell2.Offset(0, 10).Text
       currentRow = currentRow + 1

        ElseIf cell2.Value = "" Then

        End If
        Next cell2

    Set rng2 = shtSrc.Range("C6:C" & rowCount2)

    currentRow = shtDest.Range("A" & Rows.Count).End(xlUp).Row + 1

       For Each cell2 In rng2.Cells
       If cell2.Value2 <> ""  Then
       shtDest.Range("A" & currentRow + 1).Value2 = "           " & cell2.Text & " - " & cell2.Offset(0, 11).Text
       currentRow = currentRow + 1

        ElseIf cell2.Value = "" Then

        End If
        Next cell2

            Set rng2 = shtSrc.Range("C6:C" & rowCount2)

    currentRow = shtDest.Range("A" & Rows.Count).End(xlUp).Row + 1

       For Each cell2 In rng2.Cells
       If cell2.Value2 <> ""  Then
       shtDest.Range("A" & currentRow + 1).Value2 = "           " & cell2.Text & " - " & cell2.Offset(0, 12).Text
       currentRow = currentRow + 1

        ElseIf cell2.Value = "" Then

        End If
        Next cell2

End Sub

Improve this question

1 Answer 1

Reset to default
1

On the first version, try this :

 Sub Move_PPPP()

Sheets("PPPP").Select
Rows("2:1000").Select
Selection.ClearContents

Dim rowCount2 As Long, shtSrc As Worksheet
Dim shtDest As Worksheet
Dim rng2 As Range
Dim currentRow As Long

    Set shtSrc = Sheets("Roadmap")
    Set shtDest = Sheets("PPPP")

    rowCount2 = shtSrc.Cells(Rows.Count, "C").End(xlUp).Row

    Set rng2 = shtSrc.Range("C6:C" & rowCount2)

    currentRow = shtDest.Range("B" & Rows.Count).End(xlUp).Row

        For Each cell2 In rng2.Cells
        If cell2.Value <> "" Then

       shtDest.Range("B" & currentRow).Value2 = "           " & cell2.Text & " - " & cell2.Offset(0, 10).Text
       shtDest.Range("B" & currentRow + 1).Value2 = "           " & cell2.Text & " - " & cell2.Offset(0, 11).Text
       shtDest.Range("B" & currentRow + 2).Value2 = "           " & cell2.Text & " - " & cell2.Offset(0, 12).Text
          currentRow = currentRow + 1

        ElseIf cell2.Value = "" Then

        End If
        Next cell2

 Set rng2 = shtSrc.Range("D6:D" & rowCount2)

    currentRow = shtDest.Range("B" & Rows.Count).End(xlUp).Row + 1

        For Each cell2 In rng2.Cells
        If cell2.Value <> "" Then

       shtDest.Range("B" & currentRow).Value2 = "           " & cell2.Text & " - " & cell2.Offset(0, 10).Text
       shtDest.Range("B" & currentRow + 1).Value2 = "           " & cell2.Text & " - " & cell2.Offset(0, 11).Text
       shtDest.Range("B" & currentRow + 2).Value2 = "           " & cell2.Text & " - " & cell2.Offset(0, 12).Text
          currentRow = currentRow + 1

        ElseIf cell2.Value = "" Then

        End If
        Next cell2

End Sub
Improve this answer
Sign up to request clarification or add additional context in comments.

5 Comments

Thanks, that is giving me the same out put as before. It replaces the data with each offset. I need it to skip a row and place the next set of data under it. @R3uK
Ok, but in the first one, you write 3 times in the same cell shtDest.Range("B" & currentRow).Value2 = , so here is the main problem! Do you want them to be stack horizontaly or verticaly?
I want them vertical in column B on tab PPPP, not overlapping. I want the information from tab Roadmap column L to populate on tab PPPP column B row 2 - however many rows of data there is, and then Roadmap column M to populate on PPPP 1 cell under where column L data was just moved. @R3uK
OK it's far more clearer, I'm on my phone but I'll try to edit consequently. Just your 3 different (as said in the previous comment) info are still normal?
Thank you! I did not think I could keep adding the For Each / If statements. I was able to use what you gave a put it into my code to get what I needed. I really appreciate your help!! @R3uK

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.