populate worksheet from excel table-CodePudding

I have been asked to remake the excel workbook to index where we keep the items. I have an excel sheet with a table ( excel table) that contains the information.

If the there the value in column 6 ="10" then that means the item is in box 10. then I need to get the right shelve, this is found by the numbers in column 7 (shelve) and 8 (rack). subsequently the information about the item has to be put in another sheet which gives a visual representation of the box.

I am struggling to get the desired result, does anyone have some suggestions?

Sub box()
Dim rng As Range

For x = 1 To 12
Set rng = Sheets("Register").ListObject("Table1").Range(x, 8).Value

If Range("Table1").ListObject.Range(x, 6).Value = "10" Then
If Range("Table1").ListObject.Range(x, 7).Value = "1" Then
Sheets("box 10").Range(3, rng).Value = Range("Table1").ListObject.Range(x, 2).Value & Range("Table1").ListObject.Range(x, 3)

End If
End If
Next x

End Sub

CodePudding user response：

Please, try the next code. It will iterate in the table DataBodyRange and build a sheet name obtained by concatenation of "Box " with value in table column 6 (in your workbook). If such a sheet does not exist, a warning message is sent and stops the code:

Option Explicit

Sub box()
 Dim boxVal As String, tbl As ListObject, shBox As Worksheet, rngRef As Range, x As Long
 Dim shelvNo As Long, rackNo As Long
 Dim iRow As Long:   iRow = 1  ' row where "rack" exist
 Dim iCol As Long:    iCol = 1 'column letter where "rack" exists (C:C)

 Set tbl = Sheets("Register").ListObjects("Table1")
 For x = 1 To tbl.DataBodyRange.Rows.Count  'on the frist row there are ABC, ABC etc.
    If tbl.DataBodyRange.Cells(x, 1) = "" Then Exit For
    boxVal = tbl.DataBodyRange.Cells(x, 6).Value
    On Error Resume Next
     Set shBox = Sheets("Box " & boxVal) 'set the sheet of the appropriate box  'set the sheet of the appropriate box
     If Err.Number <> 0 Then
        Err.Clear: On Error GoTo 0
        MsgBox "No sheet named """ & "box " & tbl.DataBodyRange.Cells(x, 6).Value & """ exists" & vbCrLf & _
                "Please, create it and run the code again!": Exit Sub
     End If
    On Error GoTo 0
    Set rngRef = shBox.Cells(iRow, iCol)
     shelvNo = iRow   1   tbl.DataBodyRange.Cells(x, 7).Value
     rackNo = iCol   tbl.DataBodyRange.Cells(x, 8).Value - 1
     rngRef.Offset(shelvNo, rackNo).Value = tbl.DataBodyRange.Cells(x, 2).Value & " " & tbl.DataBodyRange.Cells(x, 3).Value
 Next x
 MsgBox "Ready..."
End Sub