VBA Question

  • Thread starter Thread starter Matt
  • Start date Start date
M

Matt

I am currently writing a macro that will read data out of columns and
write that data out to rows on a separate sheet. I need to write the
data out to rows in a separate sheet (going to save that as a CSV).

When I do the first for each loop it works fine. However when it goes
to do the second one - it is reading out of the S column - rather than
the specified J range. I figured out that S is the exact distance
from J that J is from A - so it is almost as if the sheet has become
offset. I am not sure why. I don't usually develop in the Excel
model - so I suspect there are some protocols that I am unaware of.

Here is the code (its a bit rough - I am still working on the logic
and haven't taken the time to polish it)

Sub MoveInfo()


Dim wSheet As Worksheet
Dim rCell As Range
Dim vCell As Range
Dim rowCount As Integer
rowCount = 0
For Each wSheet In ActiveWorkbook.Sheets
If wSheet.Name <> "Sheet3" Then
Sheets(wSheet.Name).Select
rowCount = rowCount + 1
For Each rCell In Range("A1:A33")

If rCell.Cells.Value <> "" Then
With rCell.Range("A1:A1")
.Copy
Sheets("Sheet3").Select
Cells(rowCount, Columns.Count).End(xlToLeft)(1,
2).PasteSpecial xlValues
Sheets(wSheet.Name).Select
End With
End If

Next rCell
End If
rowCount = rowCount + 1
Sheets(wSheet.Name).Select
For Each vCell In Range("J1:J33")

If vCell.Cells.Value <> "" Then
With vCell.Range("J1:J1")
.Copy
Sheets("Sheet3").Select
Cells(rowCount, Columns.Count).End(xlToLeft)(1,
2).PasteSpecial xlValues
Sheets(wSheet.Name).Select
End With
End If

Next vCell
Next wSheet

End Sub


Thanks in advance for any help or pushes in the right direction.

Thanks,

Matt
 
Hi

In second loop, you do not exclude sheet3.

Maybe this will do it:

Sub MoveInfo()
Dim wSheet As Worksheet
Dim rCell As Range
Dim vCell As Range
Dim rowCount As Integer

rowCount = 0
For Each wSheet In ActiveWorkbook.Sheets
If wSheet.Name <> "Sheet3" Then
Sheets(wSheet.Name).Select
rowCount = rowCount + 1

For Each rCell In Range("A1:A33")
If rCell.Value <> "" Then
rCell.Copy
Sheets("Sheet3").Cells(rowCount, Columns.Count) _
.End(xlToLeft).Offset(0, 1).PasteSpecial xlValues
End If
Next rCell

rowCount = rowCount + 1

For Each vCell In Range("J1:J33")
If vCell.Value <> "" Then
vCell.Copy
Sheets("Sheet3").Cells(rowCount, Columns.Count) _
.End(xlToLeft).Offset(0, 1).PasteSpecial xlValues
End If
Next vCell
End If
Next wSheet
End Sub

Regards,
Per
 
I didn't run your code but if you replace this:

With vCell.Range("J1:J1")

with

With vCell

You might be okay.

Also, FYI:

Not: Sheets(wSheet.Name).Select
Rather: wSheet.Select

Not: If rCell.Cells.Value <> "" Then
Rather: If rCell..Value <> "" Then

You are the victim of the macro recorder and its bad code.

--
Jim
|I am currently writing a macro that will read data out of columns and
| write that data out to rows on a separate sheet. I need to write the
| data out to rows in a separate sheet (going to save that as a CSV).
|
| When I do the first for each loop it works fine. However when it goes
| to do the second one - it is reading out of the S column - rather than
| the specified J range. I figured out that S is the exact distance
| from J that J is from A - so it is almost as if the sheet has become
| offset. I am not sure why. I don't usually develop in the Excel
| model - so I suspect there are some protocols that I am unaware of.
|
| Here is the code (its a bit rough - I am still working on the logic
| and haven't taken the time to polish it)
|
| Sub MoveInfo()
|
|
| Dim wSheet As Worksheet
| Dim rCell As Range
| Dim vCell As Range
| Dim rowCount As Integer
| rowCount = 0
| For Each wSheet In ActiveWorkbook.Sheets
| If wSheet.Name <> "Sheet3" Then
| Sheets(wSheet.Name).Select
| rowCount = rowCount + 1
| For Each rCell In Range("A1:A33")
|
| If rCell.Cells.Value <> "" Then
| With rCell.Range("A1:A1")
| .Copy
| Sheets("Sheet3").Select
| Cells(rowCount, Columns.Count).End(xlToLeft)(1,
| 2).PasteSpecial xlValues
| Sheets(wSheet.Name).Select
| End With
| End If
|
| Next rCell
| End If
| rowCount = rowCount + 1
| Sheets(wSheet.Name).Select
| For Each vCell In Range("J1:J33")
|
| If vCell.Cells.Value <> "" Then
| With vCell.Range("J1:J1")
| .Copy
| Sheets("Sheet3").Select
| Cells(rowCount, Columns.Count).End(xlToLeft)(1,
| 2).PasteSpecial xlValues
| Sheets(wSheet.Name).Select
| End With
| End If
|
| Next vCell
| Next wSheet
|
| End Sub
|
|
| Thanks in advance for any help or pushes in the right direction.
|
| Thanks,
|
| Matt
 
....

Your code appears to have some nasty bugs which are difficult to spot
at first because your indentation is inconsistent. Presumably you'd
want to skip transcribing values from Sheet3!J1:J33, but your topmost
If only applies to A1:A33.

Your approach is inefficient. There's no need to select anything,
neither worksheets not ranges.

Here's a thorough rewrite.


Sub MoveInfo()
Const TARGETWSNAME As String = "Sheet3"

Dim sws As Worksheet, tws As Worksheet, c As Range
Dim r As Long, k As Long

Set tws = ActiveWorkbook.Worksheets(TARGETWSNAME)
r = 0

For Each sws In ActiveWorkbook.Worksheets
If sws.Name <> TARGETWSNAME Then
r = r + 1
k = tws.Cells(r, tws.Cells.Columns.Count).End(xlToLeft).Column
For Each c In sws.Range("A1:A33")
If c.Value <> "" Then
k = k + 1
tws.Cells(r, k).Value = c.Value
End If
Next c

r = r + 1
k = tws.Cells(r, tws.Cells.Columns.Count).End(xlToLeft).Column
For Each c In sws.Range("J1:J33")
If c.Value <> "" Then
k = k + 1
tws.Cells(r, k).Value = c.Value
End If
Next c
End If
Next sws

End Sub


This may still not be what you actually want. If a given row in Sheet3
contains nothing in any cell, then the .End(xlToLeft) will give the
cell in column A. That cell would be empty, but values from the other
worksheet would begin in column B. If Sheet3 starts off empty, easier
to replace

k = tws.Cells(r, tws.Cells.Columns.Count).End(xlToLeft).Column

lines with

k = 0

to ensure entries in each row in Sheet3 begin in column A.
 
...

Your code appears to have some nasty bugs which are difficult to spot
at first because your indentation is inconsistent. Presumably you'd
want to skip transcribing values from Sheet3!J1:J33, but your topmost
If only applies to A1:A33.

Your approach is inefficient. There's no need to select anything,
neither worksheets not ranges.

Here's a thorough rewrite.

Sub MoveInfo()
  Const TARGETWSNAME As String = "Sheet3"

  Dim sws As Worksheet, tws As Worksheet, c As Range
  Dim r As Long, k As Long

  Set tws = ActiveWorkbook.Worksheets(TARGETWSNAME)
  r = 0

  For Each sws In ActiveWorkbook.Worksheets
    If sws.Name <> TARGETWSNAME Then
      r = r + 1
      k = tws.Cells(r, tws.Cells.Columns.Count).End(xlToLeft).Column
      For Each c In sws.Range("A1:A33")
        If c.Value <> "" Then
          k = k + 1
          tws.Cells(r, k).Value = c.Value
        End If
      Next c

      r = r + 1
      k = tws.Cells(r, tws.Cells.Columns.Count).End(xlToLeft).Column
      For Each c In sws.Range("J1:J33")
        If c.Value <> "" Then
          k = k + 1
          tws.Cells(r, k).Value = c.Value
        End If
      Next c
    End If
  Next sws

End Sub

This may still not be what you actually want. If a given row in Sheet3
contains nothing in any cell, then the .End(xlToLeft) will give the
cell in column A. That cell would be empty, but values from the other
worksheet would begin in column B. If Sheet3 starts off empty, easier
to replace

      k = tws.Cells(r, tws.Cells.Columns.Count).End(xlToLeft).Column

lines with

      k = 0

to ensure entries in each row in Sheet3 begin in column A.
Click to expand...
Thanks all for the help. I've been making the changes as suggested.
The way this macro needs to work is that it will read through the
workbook and take the values from each of the worksheets and turn them
into a contiguous set of rows on the final worksheet. Basically it is
taking these templates and copying them into a format that translates
into CSV. The final worksheet should just be one contiguous block of
data that will be saved as a CSV and then later on consumed by a web
service.

To that end - this line:
Cells(rowCount, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial
xlValues
uses the rowcount - so I know where to place the next line of data.
This offset (as well as the one I was using before) always starts the
data in second column. If I change it to do it in the first column,
then it overwrites all the data in the first column (i.e. I go from
having ten columns to one column that only displays the last value).
I can always start everything in the second column and then remove the
first column before I do the save - but that seems like a poor
workaround.

What am I missing?

Thanks,

Matt
 
Matt said:
To that end - this line:

Cells(rowCount, Columns.Count).End(xlToLeft).Offset(0, 1). _
PasteSpecial xlValues

uses the rowcount - so I know where to place the next line of data.
This offset (as well as the one I was using before) always starts the
data in second column.  If I change it to do it in the first column,
then it overwrites all the data in the first column (i.e. I go from
having ten columns to one column that only displays the last value).
I can always start everything in the second column and then remove the
first column before I do the save - but that seems like a poor
workaround.

What am I missing?
Click to expand...

I create a new workbook with 4 worksheets named Sheet1, Sheet2, Sheet3
and Sheet4, then I enter the following formula in Sheet1!A1.

=ADDRESS(ROW(),COLUMN(),4,,"A")

I copy this into A2:A35 and J1:J35. Then I enter the following formula
in Sheet2!A1

=ADDRESS(ROW(),COLUMN(),4,,"B")

and copy it into A2:A35 and J1:J35 in Sheet2. Then I enter the
following formula in Sheet4!A1

=ADDRESS(ROW(),COLUMN(),4,,"D")

and copy it into A2:A35 and J1:J35 in Sheet4. Sheet3 has nothing in
it. To make things interesting, I clear the cells in rows that are
multiples of 2 in Sheet1, of 3 in Sheet2 and of 5 in Sheet4 so there
are some blank cells to handle.

Then I run the macro


Sub MoveInfo()
Const TARGETWSNAME As String = "Sheet3"

Dim sws As Worksheet, tws As Worksheet, c As Range
Dim r As Long, k As Long

Set tws = ActiveWorkbook.Worksheets(TARGETWSNAME)
r = 0

For Each sws In ActiveWorkbook.Worksheets
If sws.Name <> TARGETWSNAME Then
r = r + 1
k = 0
For Each c In sws.Range("A1:A33")
If c.Value <> "" Then
k = k + 1
tws.Cells(r, k).Value = c.Value
End If
Next c

r = r + 1
k = 0
For Each c In sws.Range("J1:J33")
If c.Value <> "" Then
k = k + 1
tws.Cells(r, k).Value = c.Value
End If
Next c
End If
Next sws

End Sub


After running it, Sheet 3 contains the following (blank lines between
actual rows of in Sheet3).

Sheet3!A1:AA6

A!A1 A!A3 A!A5 A!A7 A!A9 A!A11 A!A13 A!A15 A!A17 A!A19 A!A21 A!A23 A!
A25 A!A27 A!A29 A!A31 A!A33

A!J1 A!J3 A!J5 A!J7 A!J9 A!J11 A!J13 A!J15 A!J17 A!J19 A!J21 A!J23 A!
J25 A!J27 A!J29 A!J31 A!J33

B!A1 B!A2 B!A4 B!A5 B!A7 B!A8 B!A10 B!A11 B!A13 B!A14 B!A16 B!A17 B!
A19 B!A20 B!A22 B!A23 B!A25 B!A26 B!A28 B!A29 B!A31 B!A32

B!J1 B!J2 B!J4 B!J5 B!J7 B!J8 B!J10 B!J11 B!J13 B!J14 B!J16 B!J17 B!
J19 B!J20 B!J22 B!J23 B!J25 B!J26 B!J28 B!J29 B!J31 B!J32

D!A1 D!A2 D!A3 D!A4 D!A6 D!A7 D!A8 D!A9 D!A11 D!A12 D!A13 D!A14 D!A16
D!A17 D!A18 D!A19 D!A21 D!A22 D!A23 D!A24 D!A26 D!A27 D!A28 D!A29 D!
A31 D!A32 D!A33

D!J1 D!J2 D!J3 D!J4 D!J6 D!J7 D!J8 D!J9 D!J11 D!J12 D!J13 D!J14 D!J16
D!J17 D!J18 D!J19 D!J21 D!J22 D!J23 D!J24 D!J26 D!J27 D!J28 D!J29 D!
J31 D!J32 D!J33

In other words, the expected results, not everything in column A.
 
...





I create a new workbook with 4 worksheets named Sheet1, Sheet2, Sheet3
and Sheet4, then I enter the following formula in Sheet1!A1.

=ADDRESS(ROW(),COLUMN(),4,,"A")

I copy this into A2:A35 and J1:J35. Then I enter the following formula
in Sheet2!A1

=ADDRESS(ROW(),COLUMN(),4,,"B")

and copy it into A2:A35 and J1:J35 in Sheet2. Then I enter the
following formula in Sheet4!A1

=ADDRESS(ROW(),COLUMN(),4,,"D")

and copy it into A2:A35 and J1:J35 in Sheet4. Sheet3 has nothing in
it. To make things interesting, I clear the cells in rows that are
multiples of 2 in Sheet1, of 3 in Sheet2 and of 5 in Sheet4 so there
are some blank cells to handle.

Then I run the macro

Sub MoveInfo()
  Const TARGETWSNAME As String = "Sheet3"

  Dim sws As Worksheet, tws As Worksheet, c As Range
  Dim r As Long, k As Long

  Set tws = ActiveWorkbook.Worksheets(TARGETWSNAME)
  r = 0

  For Each sws In ActiveWorkbook.Worksheets
    If sws.Name <> TARGETWSNAME Then
      r = r + 1
      k = 0
      For Each c In sws.Range("A1:A33")
        If c.Value <> "" Then
          k = k + 1
          tws.Cells(r, k).Value = c.Value
        End If
      Next c

      r = r + 1
      k = 0
      For Each c In sws.Range("J1:J33")
        If c.Value <> "" Then
          k = k + 1
          tws.Cells(r, k).Value = c.Value
        End If
      Next c
    End If
  Next sws

End Sub

After running it, Sheet 3 contains the following (blank lines between
actual rows of in Sheet3).

Sheet3!A1:AA6

A!A1    A!A3    A!A5    A!A7    A!A9    A!A11   A!A13   A!A15   A!A17   A!A19   A!A21   A!A23   A!
A25     A!A27   A!A29   A!A31   A!A33

A!J1    A!J3    A!J5    A!J7    A!J9    A!J11   A!J13   A!J15   A!J17   A!J19   A!J21   A!J23   A!
J25     A!J27   A!J29   A!J31   A!J33

B!A1    B!A2    B!A4    B!A5    B!A7    B!A8    B!A10   B!A11   B!A13   B!A14   B!A16   B!A17   B!
A19     B!A20   B!A22   B!A23   B!A25   B!A26   B!A28   B!A29   B!A31   B!A32

B!J1    B!J2    B!J4    B!J5    B!J7    B!J8    B!J10   B!J11   B!J13   B!J14   B!J16   B!J17   B!
J19     B!J20   B!J22   B!J23   B!J25   B!J26   B!J28   B!J29   B!J31   B!J32

D!A1    D!A2    D!A3    D!A4    D!A6    D!A7    D!A8    D!A9    D!A11   D!A12   D!A13   D!A14   D!A16
D!A17   D!A18   D!A19   D!A21   D!A22   D!A23   D!A24   D!A26   D!A27   D!A28   D!A29   D!
A31     D!A32   D!A33

D!J1    D!J2    D!J3    D!J4    D!J6    D!J7    D!J8    D!J9    D!J11   D!J12   D!J13   D!J14   D!J16
D!J17   D!J18   D!J19   D!J21   D!J22   D!J23   D!J24   D!J26   D!J27   D!J28   D!J29   D!
J31     D!J32   D!J33

In other words, the expected results, not everything in column A.
Click to expand...

Thanks Harlan. That worked (after I took out my bug).

Matt
 
Back
Top