I want to copy some columns of an excel sheet to another sheet.
I have written the code, which doesnt work. It gets into an infinite loop, and exits with an error. The code is:
Sub customCopy()
Dim i As Integer
Dim j As Integer
j = 1
For i = 1 To 700
If i Mod 5 = 2 Then
Columns(i).Copy Destination:=Sheets(2).Rows(j)
j = j + 1
End If
If i Mod 5 = 3 Then
Columns(i).Copy Destination:=Sheets(2).Rows(j)
j = j + 1
End If
If i Mod 5 = 4 Then
Columns(i).Copy Destination:=Sheets(2).Rows(j)
j = j + 1
End If
Next i
End Sub
Please help..
Copying a column into a row won't work.............a row is too small!
Related
Never used VBA before and basically just trying write this sub:
Sub Populate_Empties()
Dim i As Integer
Dim j As Integer
Dim n As Integer
Dim m As Integer
Dim k As Integer
' test for 50 rows...then change i from 2 to 278970
m = 2
For k = 3 To 8
For i = 2 To 50
If (IsEmpty(Cells(i, k).Value)) Then
m = i 'any statement
Else
j = i - 1
For n = m To j
Cells(n, k).Value = Cells(i, k).Value
m = i + 1
End If
End Sub
I keep getting error End If without Block
Any suggestions?
You're missing the closing statements on your for loops
Sub Populate_Empties()
Dim i As Integer
Dim j As Integer
Dim n As Integer
Dim m As Integer
Dim k As Integer
' test for 50 rows...then change i from 2 to 278970
m = 2
For k = 3 To 8
For i = 2 To 50
If (IsEmpty(Cells(i, k).Value)) Then
m = i 'any statement
Else
j = i - 1
For n = m To j
Cells(n, k).Value = Cells(i, k).Value
Next n
m = i + 1
End If
Next i
Next k
End Sub
I have been working on a macro that Archives: it selects rows with the right cell value and move them to another tab (while deleting the rows in the tab of origin).
My macro was working perfectly fine, but I decided to change my file and have different new tabs. When I computed my Macro in my new tabs, and it works on the right rows, and deletes them, but does not copy them in my "Archive tab" :
Sub Archive_Ongoing()
Test 2 : works for 2 arguments.
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("B90_Projects_OnGoing").UsedRange.Rows.Count
J = Worksheets("B90_Projects_Archived").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("B90_Projects_Archived").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("B90_Projects_OnGoing").Range("O1:O" & I)
Set yRg = Worksheets("B90_Projects_OnGoing").Range("T1:T" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "Closed" And CStr(yRg(K).Value) <> "" Then
xRg(K).Selection.Copy Destination:=Worksheets("B90_Projects_Archived").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = "Closed" Then
K = K - 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub'
Any one would be able to explain why?
Because you're decrementing your K variable within the FOR loop, which is also incrementing it. Your K variable never changes. Comment out K = K - 1 and report back?
If you're doing that on purpose to evaluate / delete a single line and shift the next values up then you might want to have a K2 variable that you increment like this:
For K = 1 To xRg.Count
If CStr(xRg(K - K2).Value) = "Closed" And CStr(yRg(K - K2).Value) <> "" Then
xRg(K - K2).Selection.Copy Destination:=Worksheets("B90_Projects_Archived").Range("A" & J + 1)
xRg(K - K2).EntireRow.Delete
If CStr(xRg(K - K2).Value) = "Closed" Then
K2 = K2 + 1
End If
J = J + 1
End If
Next
Im writing a code but i get the Invalid Next control variable reference error, and i don't know why. this is my code:
Your i and j variables are the wrong way round, you need to make sure the correct variable is with the correct indentation. Hope this helps!
Sub Network()
Dim Net(1 To 8) As Double
Dim Total(1 To 8) As Double
Dim i As Integer
For i = 1 To 8
For j = 1 To 5
Net(j) = Worksheets("Summary").Cells((i * 7) + 12, 9).Value
Next j
Next i
For j = 1 To 5
Total(j) = WorksheetFunction.Sum(Net(j))
Next j
For j = 1 To 5
Worksheets("Summary").Cells(73, 8 + j) = Total(j)
Next j
End Sub
Im having a trouble understanding For and Do while.
Im trying to put items in a listbox in this order:
1 2 3 4 5 6 7 8 9 10
1 2 3 4 5 6 7 8 9
1 2 3 4 5 6 7 8
and so on.
And the same way around
1
1 2
1 2 3
Up intil 10
How should i attack this issue?
This is what im stuck with:
Dim counter1 As Integer
Dim counter2 As Integer
For counter1 = 10 To 1 Step -1
For counter2 = 1 To 10
ListBox1.Items.Add()
Next counter2
Next counter1
Your problem is not with using the Loops alone but with using the ListBox Methods. You can achieve what you want in 2 ways:
Initially concatenate (connect) the numbers into a single string and then add it on the Listbox using AddItem Method.
Populate a multicolumn ListBox using a nested loop using AddItem and List method.
The first one should be something like below:
Private Sub CommandButton1_Click()
Dim i As Integer, j As Integer, k As Integer
Dim s As String
k = 11 ' this determines the exit condition
For i = 1 To 10
For j = 1 To 10
If k = j Then Exit For
s = IIf(s = "", j, s & " " & j) ' construct the string
Next
Me.ListBox1.AddItem s ' add in listbox
s = ""
k = k - 1
Next
End Sub
Which will result to:
Edit1 No.2 Above
Private Sub CommandButton1_Click()
Dim i As Integer, j As Integer, k As Integer
With Me.ListBox1
.ColumnCount = 10
.ColumnWidths = "15;15;15;15;15;15;15;15;15;15"
k = 10 ' determines exit condition
For i = 1 To 10
For j = 1 To 10
If j = 1 Then
.AddItem j ' if it is the number 1, use AddItem method
Else
.List(.ListCount - 1, j - 1) = j ' else use the List method
End If
If k = j Then Exit For
Next
k = k - 1
Next
End With
End Sub
This time, we do not add concatenated numbers into the ListBox but we add it 1 by 1 in each row and column of a multicolumn ListBox. Result would be:
I leave the ascending numbers to you. :) I hope this gets you going.
I am receiving a large file 500k+ lines but all the content is in column A. I need to run a macro that will transpose the data into matrix form but will only create a new row when it finds "KEY*" in the ActiveCell. For example:
| KEY 4759839 | asljhk | 35049 | | sklahksdjf|
| KEY 359 | skj | 487 |y| 2985789 |
The above data in my file would originally look like this in column A:
KEY 4759839
asljhk
35049
sklahksdjf
KEY 359
skj
487
y
2985789
Considerations:
Blank cells need to be transposed as well, so the macro cant stop based on emptyCell
The number of cells between KEY's is not constant so it actually needs to read the cell to know if it should create a new row
It can either stop based on say 20 empty cells in a row or prompt for a max row number
(Optional) It would be nice if there was some sort of visual indicator for the last item in a row so that its possible to tell if the last item(s) were blank cells
I searched around and found a macro that had the same general theme but it went based on every 6 lines and I did not know enough to try to modify it for my case. But in case it helps here it is:
Sub kTest()
Dim a, w(), i As Long, j As Long, c As Integer
a = Range([a1], [a500000].End(xlUp))
ReDim w(1 To UBound(a, 1), 1 To 6)
j = 1
For i = 1 To UBound(a, 1)
c = 1 + (i - 1) Mod 6: w(j, c) = a(i, 1)
If c = 6 Then j = j + 1
Next i
[c1].Resize(j, 6) = w
End Sub
I would greatly appreciate any help you can give me!
This works with the sample data you provided in your question - it outputs the result in a table starting in B1. It runs in less than one second for 500k rows on my machine.
Sub kTest()
Dim originalData As Variant
Dim result As Variant
Dim i As Long
Dim j As Long
Dim k As Long
Dim countKeys As Long
Dim countColumns As Long
Dim maxColumns As Long
originalData = Range([a1], [a500000].End(xlUp))
countKeys = 0
maxColumns = 0
'Calculate the number of lines and columns that will be required
For i = LBound(originalData, 1) To UBound(originalData, 1)
If Left(originalData(i, 1), 3) = "KEY" Then
countKeys = countKeys + 1
maxColumns = IIf(countColumns > maxColumns, countColumns, maxColumns)
countColumns = 1
Else
countColumns = countColumns + 1
End If
Next i
'Create the resulting array
ReDim result(1 To countKeys, 1 To maxColumns) As Variant
j = 0
k = 1
For i = LBound(originalData, 1) To UBound(originalData, 1)
If Left(originalData(i, 1), 3) = "KEY" Then
j = j + 1
k = 1
Else
k = k + 1
End If
result(j, k) = originalData(i, 1)
Next i
With ActiveSheet
.Cells(1, 2).Resize(UBound(result, 1), UBound(result, 2)) = result
End With
End Sub
Tested and works:
Sub test()
Row = 0
col = 1
'Find the last not empty cell by selecting the bottom cell and moving up
Max = Range("A650000").End(xlUp).Row 'Or whatever the last allowed row number is
'loop through the data
For i = 1 To Max
'Check if the left 3 characters of the cell are "KEY" and start a new row if they are
If (Left(Range("A" & i).Value, 3) = "KEY") Then
Row = Row + 1
col = 1
End If
Cells(Row, col).Value = Range("A" & i).Value
If (i > Row) Then
Range("A" & i).Value = ""
End If
col = col + 1
Next i
End Sub