CODEWITHSUNDEEP
vbaexcelloopsmacros
I Harris
I Harris

Reputation: 3

Loop cell offset?

I'm very new to VBA I've done a few macros to help speed processes up in the workshop by automating workshop sheets etc, so excuse any long winded code, but this one has me stumped.

We have a tool sheet for our machines and I want to automate it that when you put a 4 digit code in a cell i.e "1 4 A V" it will fill out various sections of the tool sheets with more detailed descriptions from another parameter worksheet, here is the code.

Sub toolsheet()

'START box 1-----------------------------------------

Dim Box1 As String
Dim Box1Array() As String


Box1 = Cells(6, "B").Value
Box1Array = Split(Box1)

'TOOL DESCRIPTION ----------------------------------------

If Box1Array(0) = 1 Then
Worksheets(1).Range("C7") = Worksheets(4).Range("G3")
Worksheets(1).Range("B7") = 1

ElseIf Box1Array(0) = 2 Then
Worksheets(1).Range("C7") = Worksheets(4).Range("G4")
Worksheets(1).Range("B7") = 2

ElseIf Box1Array(0) = 3 Then
Worksheets(1).Range("C7") = Worksheets(4).Range("G5")
Worksheets(1).Range("B7") = 3

ElseIf Box1Array(0) = 4 Then
Worksheets(1).Range("C7") = Worksheets(4).Range("G6")
Worksheets(1).Range("B7") = 4

ElseIf Box1Array(0) = 5 Then
Worksheets(1).Range("C7") = Worksheets(4).Range("G7")
Worksheets(1).Range("B7") = 5

ElseIf Box1Array(0) = 6 Then
Worksheets(1).Range("C7") = Worksheets(4).Range("G8")
Worksheets(1).Range("B7") = 6

ElseIf Box1Array(0) = 7 Then
Worksheets(1).Range("C7") = Worksheets(4).Range("G9")
Worksheets(1).Range("B7") = 7

ElseIf Box1Array(0) = 8 Then
Worksheets(1).Range("C7") = Worksheets(4).Range("G10")
Worksheets(1).Range("B7") = 8

ElseIf Box1Array(0) = 9 Then
Worksheets(1).Range("C7") = Worksheets(4).Range("G11")
Worksheets(1).Range("B7") = 9

ElseIf Box1Array(0) = 10 Then
Worksheets(1).Range("C7") = Worksheets(4).Range("G12")
Worksheets(1).Range("B7") = 10

End If

End Sub

I've got 2 problems. 1, if there is nothing in the cell that it splits it throws up an error and 2, I want repeat this process 16 times each time 3 cells down from the last in worksheet 1 but keeping the same parameters to read in worksheet 4, I've tried looping it with an offset but once again if there is nothing in the cell then it throws up an error.

Thanks for any help

Iain

edit:

Thanks for the help I now have the code running through and works perfectly but only if I enter information perfectly.

If Len(Join(Box1Array)) > 0 Then

If Box1Array(1) = 1 Then
Range("I5").Offset(i, 0) = Worksheets(4).Range("B3")

Although the box1array is above 0 the second part of the split is not so it throws up an error again. i tried putting,

If Len(Join(Box1Array(1))) > 0 Then

If Box1Array(1) = 1 Then
Range("I5").Offset(i, 0) = Worksheets(4).Range("B3")

But it doesn't like that.

Thanks

Iain

Upvotes: 0

Views: 138

Answers (3)

Dirk Reichel
Dirk Reichel

Reputation: 7979

just looking at your code...

Sub toolsheet()

  'START box 1-----------------------------------------

  Dim Box1Array() As String

  If Not Len(Cells(6, "B").Value) Then Exit Sub
  Box1Array = Split(Cells(6, "B").Value, " ")

  'TOOL DESCRIPTION ----------------------------------------

  Box1Array(0) = Int(Box1Array(0))

  If Box1Array(0) >= 1 And Box1Array(0) <= 16 Then
    Worksheets(1).Range("C7").Value = Worksheets(4).Cells(Box1Array(0) + 2, "G").Value
    Worksheets(1).Range("B7") = Box1Array(0)
  End If

End Sub

should do the same... there is no need to split this whole process up if there is such a logical order ;)

Upvotes: 1

user3598756
user3598756

Reputation: 29421

quite hard to understand your goal

may be this could be what you're after:

Option Explicit

Sub toolsheet()    
    Dim sht1 As Worksheet, sht4 As Worksheet '<~~ declare your worksheet variables
    Dim i As Long '<~~ declare loop counter

    Set sht1 = Worksheets("Tool") '<~~ set "tool" worksheet; change "Tool" with the actual name of your "Tool" worksheet
    Set sht4 = Worksheets("Parameter") '<~~ set "parameter" worksheet, change "Parameter" with actual name of your "parameter" worksheet

    With sht1.Cells(6, "B") '<~~ take cell "B6" of "tool" sheet as reference cell
        For i = 1 To 16 '<~~ loop 16 times
            With .Offset((i - 1) * 3) '<~~ at every loop after the first, offset cell 3 cells down from reference cell
                If Len(WorksheetFunction.Trim(.Value)) <> 0 Then .Offset(1).Resize(, 2) = Array(sht4.Range("G3").Offset(Split(.Value)(0)), Split(.Value)(0)) '<~~ if the loop current cell isn't blank then make the values copy in the range one row down from current cell and two columns wide
            End With
        Next i
    End With
End Sub

Upvotes: 0

Stupid_Intern
Stupid_Intern

Reputation: 3450

1, if there is nothing in the cell that it splits it throws up an error

Ofcourse it will throw subscript out of range error since you didn't split anything and hence there are no array elements to use

You also didn't specify the delimiter to split .....

Box1 = Cells(6, "B").Value
Box1Array = Split(Box1, "?")    'Replace Question Mark with delimiter.    

'TOOL DESCRIPTION ----------------------------------------

If Box1Array(0) = 1 Then

To avoid this use a check to see if array elements exist.

if len(join(Box1Array)) > 0 then

2, I want repeat this process 16 times each time 3 cells down from the last in worksheet 1 but keeping the same parameters to read in worksheet 4, I've tried looping it with an offset but once again if there is nothing in the cell then it throws up an error.

Instead of If else use Select Case Box1Array(0) to properly structure your code.

Upvotes: 0

Related Questions