nested loops

[TheSardOz]

Hi all,
I am trying to create a nested loop to sort out a price list.
I want to add the finish type abbreviation to the code number.
The issue that i am facing is that for each cell in the code column I need to add AB or BC based on the Adjicent cell value (the price).
If the column B-C-D-E-F has a value in I need to add a value to the code.
the logic is:
cells A2 has the value of 396, cell B2 has a value in so in a new sheet in cell A2 I need to paste in 396-AB and the rest of the values in the same row
then repeat this process for column C3 ( if no value skip) and check the next cell, D3 has a value in then in the new sheet in A3 i will have 396-NP ect.
I am not sure how to tackle this one i have try few nested loops but I keep on failing.

Thank you in advance for your help

 

[TheSardOz]

maybe

Sub AddFinishToCode()

    Dim dataSheet As Worksheet
    Set dataSheet = ThisWorkbook.Sheets("Data") ' Change "Data" to the name of your sheet
   
    Dim outputSheet As Worksheet
    Set outputSheet = ThisWorkbook.Sheets.Add(After:=dataSheet) ' Creates a new sheet for the output
    outputSheet.Name = "Output" ' Change "Output" to the name you want for the output sheet
   
    Dim lastRow As Long
    lastRow = dataSheet.Cells(Rows.Count, 1).End(xlUp).Row
   
    Dim i As Long
    Dim code As String
    Dim finish As String
   
    For i = 2 To lastRow ' Assumes data starts on row 2, change as needed
        code = dataSheet.Cells(i, 1).Value ' Get the code from column A
        If Not IsEmpty(dataSheet.Cells(i, 2)) Then ' Check if there's a price in column B
            finish = "-AB" ' Set the finish based on the adjacent price
        ElseIf Not IsEmpty(dataSheet.Cells(i, 3)) Then
            finish = "-BC"
        Else
            finish = "" ' If no price in adjacent columns, don't add a finish
        End If
        If finish <> "" Then ' Only write to output if there's a finish to add
            outputSheet.Cells(i, 1).Value = code & finish ' Write the new code to the output sheet
            outputSheet.Cells(i, 2).Resize(1, 4).Value = dataSheet.Cells(i, 2).Resize(1, 4).Value ' Copy the rest of the data to the output sheet
        End If
    Next i
   
End Sub

Thank you !

 

[TheSardOz]

Maybe something like:

Sub test()
    Dim oRng As Range, iRng As Range
    Dim var As Variant, eRow As Long
    Dim x As Long, y As Long, z As Long
   
    eRow = Range("A" & Rows.Count).End(xlUp).Row
    Set oRng = Range("A1:F" & eRow)
    Set iRng = Range("B2:F" & eRow)
    var = oRng.Value
   
    ReDim oVar(Application.CountA(iRng) - 1, 1)
   
    For x = 2 To UBound(var)
        For y = 2 To UBound(var, 2)
            If var(x, y) <> "" Then
                oVar(z, 0) = var(x, 1) & "-" & Right(var(1, y), 2)
                oVar(z, 1) = var(x, y)
                z = z + 1
            End If
        Next y
    Next x
   
    Range("I2").Resize(UBound(oVar) + 1, UBound(oVar, 2) + 1) = oVar
End Sub

Hi Georgieboy, Thak you again for you code and time, it worked perfectly! I just do not quite understand few bits with the arrays, I was wondering if you could add some notes for me so I can actually learn something new instead of just pasting in a code.
Thank you!

 

[Georgiboy]

Here is what ChatGPT has to say about the code:

1. Define variables: oRng, iRng, var, eRow, x, y, and z.
2. Find the last used row in column A and store the row number in the variable eRow.
3. Set the variable oRng to be the range from cell A1 to the last used row in column F.
4. Set the variable iRng to be the range from cell B2 to the last used row in column F.
5. Store the values of the range oRng in the variable var.
6. Resize the array oVar to have the same number of rows as the number of non-blank cells in range iRng and 2 columns.
7. Loop through each row and column in the variable var and check if the value is not empty.
8. If the value is not empty, assign the value in oVar(z, 0) to be the concatenation of the value in column A with the last 2 characters of the value in row 1 of the same column.
9. Assign the value in oVar(z, 1) to be the value in the current cell.
10. Increment the variable z by 1.
11. Write the contents of the oVar array to the worksheet, starting at cell I2. The output will have the concatenated values in column I and the original values in column J.

In summary, the code creates a new table based on the data from the existing table by concatenating two columns and rearranging the data into a new format. The output is written to a new location on the worksheet.

And this is ChatGPT annotating the code:

Sub test()
    ' Declare variables
    Dim oRng As Range, iRng As Range ' ranges used for input data
    Dim var As Variant, eRow As Long ' variant to hold input data and last row of data
    Dim x As Long, y As Long, z As Long ' counters for loops and array

    ' Find the last used row in column A and store in eRow
    eRow = Range("A" & Rows.Count).End(xlUp).Row

    ' Set the range oRng to the range A1 to the last used row in column F
    Set oRng = Range("A1:F" & eRow)

    ' Set the range iRng to the range B2 to the last used row in column F
    Set iRng = Range("B2:F" & eRow)

    ' Store the values of range oRng in the variant var
    var = oRng.Value

    ' Resize the oVar array based on the number of non-blank cells in range iRng
    ReDim oVar(Application.CountA(iRng) - 1, 1)

    ' Loop through each row and column in the var array and store non-blank values in oVar array
    For x = 2 To UBound(var)
        For y = 2 To UBound(var, 2)
            ' If the cell is not empty, concatenate the value in column A with the last 2 characters of the value in row 1 of the same column
            ' and store in column 0 of the oVar array. Store the original value in column 1 of the oVar array.
            If var(x, y) <> "" Then
                oVar(z, 0) = var(x, 1) & "-" & Right(var(1, y), 2)
                oVar(z, 1) = var(x, y)
                z = z + 1 ' increment the row index for the oVar array
            End If
        Next y
    Next x

    ' Write the contents of the oVar array to the worksheet starting at cell I2
    Range("I2").Resize(UBound(oVar) + 1, UBound(oVar, 2) + 1) = oVar
End Sub

Hope this helps