CODEWITHSUNDEEP
arraysvbaexcel
SQLserving
SQLserving

Reputation: 400

Range to Array based on Conditions

I have a workbook with two worksheets (w1 and w2)
There are two columns in the middle of the w1, col1 looks like this: 

Sample No.                           
BB01_1_6 6  
BB01_1_6 12  
BB01_1_7 6  
BB01_1_7 12  
BB02_1_9 6  
BB02_1_9 12

col2 looks like this: 

Results  
8.8  
10.1  
8.9  
6.8  
7.9  
8.4

I would like the worksheet2 (w2) to look like this:

Sample|ID|Serial|Mold6|Mold12  
BB01  |1 |6     |8.8  |10.1  
BB01  |1 |7     |8.9  |6.8  
BB02  |1 |9     |7.9  |8.4

So I want to get all the sample# for 6 in one array and for 12 in another and another two with the Results.
I would then like to loop through one array and just print the first index value of all arrays
Here is what I have done so far: 

Dim rng6 As Range    
Dim rng12 As Range    
Dim contra As Range    
With Sheets("w1")  
   Set contra = .Range(.Range("J18"), .Range("J18").End(xlDown))   
End With  
For Each c In contra    

    If Right(c.Text, 10) = "6" Then  
        Set rng6 = c  
        Else  
        Set rng12 = c  
    End If  
  Next

It does not go through the loop.
Where am I going wrong and what is the best way to do this? I have given as much information as I thought was appropriate, but if you need more, let me know.

Upvotes: 0

Views: 56

Answers (2)

QHarr
QHarr

Reputation: 84465

I think I may have misunderstood. If they are always in pairs with 6 followed by 12 could you do the following?

Option Explicit

Sub RearrangeData()

    Dim wb As Workbook
    Dim wsSource As Worksheet
    Dim lastRow As Long
    Dim loopRange As Range

    Set wb = ThisWorkbook
    Set wsSource = wb.Worksheets("Worksheet")    'change to sheet name containing delivery info

    With wsSource

        lastRow = .Cells(.Rows.Count, "J").End(xlUp).Row 'Change as appropriate
        Set loopRange = .Range("J18:J" & lastRow)

    End With

    Dim currentSample As Long
    Dim counter As Long

    Dim targetSheet As Worksheet

    Set targetSheet = wb.Worksheets("Sheet2")

    For currentSample = loopRange.Row To loopRange.Row + loopRange.Rows.Count - 2 Step 2

      Dim tempString As String
      tempString = wsSource.Cells(currentSample, "J")

      counter = counter + 1

      targetSheet.Cells(counter, 1) = Left$(tempString, 4)
      targetSheet.Cells(counter, 2) = Mid$(tempString, 6, 1)
      targetSheet.Cells(counter, 3) = Mid$(tempString, 8, 1)
      targetSheet.Cells(counter, 4) = wsSource.Cells(currentSample, 43)
      targetSheet.Cells(counter, 5) = wsSource.Cells(currentSample + 1, 43)

    Next currentSample

End Sub

Upvotes: 1

PeterT
PeterT

Reputation: 8557

Only a couple quick modifications to what you're doing:

First of all, please ALWAYS use Option Explicit. Turn this on automatically by using the VBE and going to Tools-->Options-->Editor, then check Require Variable Declarations. It will save you lots of heartache and grief later.

Next, you're checking the string that comes in each cell of your loop by looking at the rightmost 12 characters. This is basically ALL of the characters in the string. If you split the string at the space, then it's easy to look at the second item and check for your serial value.

Option Explicit

Sub test()
    Dim rng6 As Range
    Dim rng12 As Range
    Dim contra As Range
    With Sheets("Worksheet")
        Set contra = .Range(.Range("J18"), .Range("J18").End(xlDown))
    End With
    Dim c As Variant
    For Each c In contra
        Dim workingString() As String
        workingString = Split(c.Text, " ")
        If workingString(1) = "6" Then
            Set rng6 = c
        Else
            Set rng12 = c
        End If
    Next
End Sub

Upvotes: 1

Related Questions