0 votes
in VBA by Beginner (48 points)

I got this code from the internet and I adjusted the range. The code copies vertical data to horizanal data but it gives me the error "run time error division by zero"

I truly appreciate any help.

Thanks in advance.

Sub VerticalToHorizontal()
  Dim a As Variant, b As Variant
  Dim RowsPerBlock As Long, NumBlocks As Long, i As Long, j As Long, BaseNum As Long
  
  RowsPerBlock = Columns(1).Find(What:=Range("A1").Value, LookAt:=xlWhole).Row - 1
  a = Range("B1:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
  NumBlocks = UBound(a) / RowsPerBlock
  ReDim b(1 To NumBlocks, 1 To RowsPerBlock)
  Do Until i = NumBlocks
    i = i + 1
    BaseNum = (i - 1) * RowsPerBlock
    For j = 1 To RowsPerBlock
      b(i, j) = a(BaseNum + j, 1)
    Next j
  Loop
  With Range("e1").Resize(, RowsPerBlock)
    .Value = Application.Transpose(Range("A1").Resize(RowsPerBlock).Value)
    .Offset(1).Resize(NumBlocks).Value = b
  End With
End Sub

 

1 Answer

+2 votes
by Skilled (477 points)
selected by
 
Best answer


Hi abdelfattah,

You just need to trap the conditions where the macro should not try to transpose the column. Here is the modified macro:


Sub VerticalToHorizontal()
  Dim a As Variant, b As Variant
  Dim RowsPerBlock As Long, NumBlocks As Long, i As Long, j As Long, BaseNum As Long
  
  RowsPerBlock = Columns(1).Find(What:=Range("A1").Value, LookAt:=xlWhole).Row - 1
  
  '*** RowsPerBlock will =1 if A1 is empty  or 
  '*** it will = 0 if A1 is the only cell in the column with data

  If RowsPerBlock = 0 Or Range("A1") = "" Then
    Exit Sub
  End If

  a = Range("B1:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
  NumBlocks = UBound(a) / RowsPerBlock
  ReDim b(1 To NumBlocks, 1 To RowsPerBlock)
  Do Until i = NumBlocks
    i = i + 1
    BaseNum = (i - 1) * RowsPerBlock
    For j = 1 To RowsPerBlock
      b(i, j) = a(BaseNum + j, 1)
    Next j
  Loop
  With Range("e1").Resize(, RowsPerBlock)
    .Value = Application.Transpose(Range("A1").Resize(RowsPerBlock).Value)
    .Offset(1).Resize(NumBlocks).Value = b
  End With
End Sub

 

by Beginner (48 points)

thanks  parser   the  code  does not   work   no  error  no  any  data   

? this  is  my  data , do  you  have  any  idea

 

by Skilled (477 points)

Hi abdelfattah,

As I step through the code, I see that it is designed to look at cell A1. Next, it looks at all of the cells below A1, in other words, column A. The Find statement is looking for another cell to have exactly the same data as A1.

If the macro finds a match, it takes the range from A2 to Axxx, where xxx is the row that contains the cell with the same data as A1.

It then transposes  the range A2 - Axxx (switches from vertical column to horizontal row) so that the data is listed across as many columns as needed.

So, essentially, the data you have listed above has no clear need for the macro.

Do you know which columns are supposed to transposed?

 

Cheers,

 

Mitch

 

 

by Beginner (48 points)

hi, pareser   thanks   fror  this   explenetion   about  how   the  macro   runs    i  thought   this  cod  will transpose    from   a:c    to   right  columns      you  can  see   expected   result    move right  columns   as   my  picture    ,moreover i  will   add statment  for  owner's code   he  said  this  " original data in columns A:B starting at row 1 .
- every 'block' of data has the same labels in the same order in column A.
- nothing is in column e and columns to the right

The code will automatically determine the headings required and enter them in e1, f1, g1,h1, 

..."

by Skilled (477 points)

Hi abdelfattah,

Well, this macro you pulled down may not get it done unless, that sample is just one of many blocks.

So, if A5 has CODE, A6 has BRAND, etc. then your macro will take care of transposing the data to E1:H1.

Since the original question was about division by zero, please mark it complete and open a new question if you need further help on the data processing itself.

I'd like to offer a suggestion: you have the foundation of the solution in the current macro. Developing solutions is about gaining insight into how VBA accomplishes tasks. Excel is challenging because you not only have to learn code, you also have to deal with worksheet objects (cells, ranges, etc.)

To gain this insight, most of start by doing what you do, grabbing code snippets and analyzing them. You can do this with breakpoints, the F8 key and lots of Debug.Print statements.

How much of this you do determines how quickly you become proficient at handling exceptions and other unexpected macro behavior.

Cheers,

 

Mitch

 

 

by Beginner (48 points)
thanks Parser
by Skilled (477 points)
+1
You're welcome :)

Welcome to wellsr Q&A
wellsr Q&A is the VBA and Python programming community that rewards you for learning how to code.

Getting Started
Register
VBA Cheat Sheets (On Sale Now)

Earn free prizes for asking VBA and Python questions and for answering questions asked by others in our community.

Looking for something else? Hire our professional VBA Help, instead.

What makes us different?
Our points system rewards you with a chance for free gifts based on the quality of your questions and answers. All you have to do is post and you could get rewarded, like these members:

ParserMonster $25 Amazon Gift Card
Hightree $10 Amazon Gift Card
Thales1 $10 Amazon Gift Card
runfunke $10 Amazon Gift Card
coolag $10 Amazon Gift Card
Siew Hun $10 Amazon Gift Card

So, why don't you join us? It really is an encouraging way to motivate members in our VBA and Python community.

Register

For more programming tips visit the VBA Tutorials Blog and the Python Tutorials Blog.

...