Copy data with IF & AND

[witham]

Hi All,

I have got myself in to a bit of a Monday morning mess!

I have used a piece of code to do the following:

1.Read through a section of data (B17:M47)
2.IF "B" is NOT blank and "M" IS, copy it
3.Find first blank row in range (B17:M47) of new worksheet
4.Paste it.

It works well and is stable. I am trying to adjust the code to now do this

1.Read the same section of data
2.IF "B" is NOT blank and "F" contains an "X" copy JUST "B"
3.Find the first clear row in range B4:B13,E4:E13 or G4:G13
3.Paste it.

The problems I am getting are:
It only copies the first entry regardless of data
It copies the whole row instead of just the first cell
It copies whether there is an "X" or not

Can anyone shed any light on this for me?

Thanks in advance, Witham

        Dim i As Long
        Dim MS As Worksheet
        Set MS = Sheets(NxtSht) 'variable defined elsewhere in code
        NR = 17
        With Sheets(ThsSht)       'variable defined elsewhere in code
        For i = 17 To 47
        If .Cells(i, "B") <> vbNullString And .Cells(i, "M") = vbNullString Then
        .Cells(i, "B").Resize(, 11).Copy MS.Range("B" & NR)
        NR = NR + 1
        End If
        Next i
        End With

 

[Andrew Poulsom]

What code have you tried that's not working?

 

[witham]

Dim SFleet As Long
Dim WrkSht As Worksheet
Set WrkSht = Sheets(NxtSht)
ORow = 17
NRow = 4


With WrkSht


For SFleet = 17 To 39
If .Cells(SFleet, "B") <> vbNullString And .Cells(SFleet, "F") = "I" Then
   .Cells(ORow, "B").Resize(, 10).Copy WrkSht.Range("B" & NRow)
   NRow = NRow + 1
   End If
   Next SFleet
   End With

 

[Snakehips]

witham,

If I have understood correctly and you want B paste to the next available CELL in B4:B1 then E4:E13 then G4:G13 then maybe this will help?

Dim i As Long
        Dim MS As Worksheet
        Set MS = Sheets(NxtSht) 'variable defined elsewhere in code
        NR = 17
        With Sheets(ThsSht)       'variable defined elsewhere in code
        For i = 17 To 47
        If .Cells(i, "B") <> vbNullString And .Cells(i, "F") = "X" Then
        For Each cell In MS.Range("B4:B13,E4:E13,G4:G13")
        If cell = vbNullString Then
        .Cells(i, "B").Copy cell
        Exit For
        End If
        Next cell
        NR = NR + 1
        End If
        Next i
        End With

**** Based on your original code not the second post!!

 

[Andrew Poulsom]

Dim SFleet As Long
Dim WrkSht As Worksheet
Set WrkSht = Sheets(NxtSht)
ORow = 17
NRow = 4


With WrkSht


For SFleet = 17 To 39
If .Cells(SFleet, "B") <> vbNullString And .Cells(SFleet, "F") = "I" Then
   .Cells(ORow, "B").Resize(, 10).Copy WrkSht.Range("B" & NRow)
   NRow = NRow + 1
   End If
   Next SFleet
   End With

Should ORow be SFleet?

.Cells(sFleet, "B").Resize(, 10).Copy WrkSht.Range("B" & NRow)

 

[witham]

Thanks Andrew, that certainly helped.

The issue remaining is, it copies all the data from that row and not just the data in "B", with a resultant knock on with the formatting (I tried to post an image but my administrator won't allow it).
Also, how do I get it to start in E4 when B13 is full, then G4 when E13 is full?

 

[Snakehips]

witham,

The issue remaining is, it copies all the data from that row and not just the data in "B", with a resultant knock on with the formatting (I tried to post an image but my administrator won't allow it).
Also, how do I get it to start in E4 when B13 is full, then G4 when E13 is full?

Adapting my first code to suit your new set of variables?????

For SFleet = 17 To 39
        If .Cells(SFleet, "B") <> vbNullString And .Cells(SFleet, "F") = "I" Then
        For Each cell In WrkSht.Range("B4:B13,E4:E13,G4:G13")
        If cell = vbNullString Then
        .Cells(SFleet, "B").Copy cell
        Exit For
        End If
        Next cell
        ORow = ORow + 1  '???????
        End If
        Next SFleet
        End With

 

[witham]

Wow, thanks Snakehips. That works a treat.
Are the question marks because it seems to be a redundant line of code?
I've just removed it and it still runs fine.

 

[Snakehips]

witham,

Glad it works.

Your posted code is obviously just an extract. I couldn't be sure but I thought that maybe NRow and ORow were just remnants of your own attempts to get the code working so just threw in the ?????s for no good reason whatsoever!!!

 

[witham]

haha, yes it was a remnant of a failed attempt. The ????????????? have prompted a tidy up!

Have a great week & thanks to both of you