Making 4 columns from 2 columns

rlnye

New Member
Joined
Apr 7, 2002
Messages
43
In Excel 2000, a spreadsheet I use extracts data in two columns (column A1 is numeric and B1 in descriptive text) the number of rows in the two columns varies...sometimes just 6 rows in the two columns othertimes 32 rows. What I need to do is if the number of rows in A1:B? is over 15, divide the number of rows in half and copy the bottom half to D1. In other words if the number of rows is A1:B24...copy the bottom 12 rows A13:B24 to D1. If I need to use VB code can someone help with the code...I'm a new comer to Excel. Thanks
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Try this:

Code:
Sub Test()
    Dim Source As Range
    Dim Target As Range
    Dim RowCount As Long
    Dim Half As Long
    Set Source = Range("A1:B" & Range("A1").End(xlDown).Row)
    If Source.Rows.Count <= 15 Then Exit Sub
    Set Target = Range("D1")
    RowCount = Source.Rows.Count
    Half = Int(Source.Rows.Count / 2 + 0.5)
    Set Source = Source.Offset(Half, 0).Resize(RowCount - Half)
    Source.Cut Target
End Sub
 

rlnye

New Member
Joined
Apr 7, 2002
Messages
43
Andrew, thanks for the VB code, it works great! I have a little problem that I created by inserting a few simple macro codes in with what you gave me. The problem is, if the number of rows is less than 15 the macro ends. What I need to do is have it make two rows if the number of rows are more than 15...which it does. Or, continue to run the other macro code if the number of rows is less than 15. Can you use some form of "loop?"

Thanks again for the help
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Like this?

Code:
Sub Test()
    Dim Source As Range
    Dim Target As Range
    Dim RowCount As Long
    Dim Half As Long
    Set Source = Range("A1:B" & Range("A1").End(xlDown).Row)
    If Source.Rows.Count <= 15 Then
       Set Target = Range("D1")
       RowCount = Source.Rows.Count
       Half = Int(Source.Rows.Count / 2 + 0.5)
       Set Source = Source.Offset(Half, 0).Resize(RowCount - Half)
       Source.Cut Target
    End If
End Sub
 

rlnye

New Member
Joined
Apr 7, 2002
Messages
43

ADVERTISEMENT

Andrew, thank you very much...you have saved me many, many brain cells that I cannot afford to lose. It works great!

Thanks again.
 

rlnye

New Member
Joined
Apr 7, 2002
Messages
43
Andrew, thank you very much...you have saved me many, many brain cells that I cannot afford to lose. It works great!

Thanks again.
 

rlnye

New Member
Joined
Apr 7, 2002
Messages
43

ADVERTISEMENT

Andrew, thank you very much...you have saved me many, many brain cells that I cannot afford to lose. It works great!

Thanks again.
 

rlnye

New Member
Joined
Apr 7, 2002
Messages
43
Andrew, I guess I spoke to soon. I copied the complete macro below...what I really am trying to do is, if the number of rows is >=15 then make two rows, if it is <=15 run the macro code below the code you gave me. I hope this makes sense...thanks again.

Sub MakeFinalBidSheet()
'
' MakeFinalBidSheet Macro
' Macro recorded 9/11/2002 by Ronnie
'

Sheets("Sign WorkSheet & Bid Sheet").Range("B8:D141").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("Sign WorkSheet & Bid Sheet").Range( _
"C4:C5"), CopyToRange:=Range("A1"), Unique:=False
Range("A1:D55").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft

Dim Source As Range
Dim Target As Range
Dim RowCount As Long
Dim Half As Long
Set Source = Range("A1:B40" & Range("A1").End(xlDown).Row)
If Source.Rows.Count <= 15 Then
Set Target = Range("E1")
RowCount = Source.Rows.Count
Half = Int(Source.Rows.Count / 2 + 0.5)
Set Source = Source.Offset(Half, 0).Resize(RowCount - Half)
Source.Cut Target
End If

Sheets("Legal Description").Select
ActiveWindow.ScrollRow = 1
Range("A22:A34").Select
Selection.Copy
Sheets("Bid Sheet WorkSheet").Select

Dim LastRow As Long
Dim NextRow As Long

' determine where the data ends on Column A Legal Description
Worksheets("Legal Description").Activate
Range("A65536").Select
ActiveCell.End(xlUp).Select
LastRow = ActiveCell.Row

' copy the data from Column A in Legal Description Worksheet
Range("A22:A34").Copy

' Determine where to add the new data in Column A of Bid WorkSheet
Worksheets("Bid Sheet WorkSheet").Activate
Range("A65536").Select
ActiveCell.End(xlUp).Offset(3, 0).Select
NextRow = ActiveCell.Row
ActiveSheet.Paste
Application.CutCopyMode = False

' paste the data to Column A Sign WorkSheet & Bid Sheet
' Worksheets("Bid Sheet WorkSheet").Range("A" & NextRow).Select
' ActiveSheet.Paste
' Application.CutCopyMode = False
' ActiveSheet.Paste

End Sub
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Set Source = Range("A1:B40" & Range("A1").End(xlDown).Row)

should be

Set Source = Range("A1:B" & Range("A1").End(xlDown).Row)

Other than that, what isn't working?
 

rlnye

New Member
Joined
Apr 7, 2002
Messages
43
Andrew, it makes two rows if the number of rows is 15 or less. What I need to do is make two rows only if there is 15 or more rows...and if less than or more than 15 rows, to continue to run the VB code under your code.

Thanks for taking the time to help.
 

Forum statistics

Threads
1,143,613
Messages
5,719,716
Members
422,242
Latest member
hishamkhatri

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top