So I have the above code, I want to continue on this logic: if K4 is not empty then copy L3 to L4 and so on, until one cell is empty (for example K32 is not empty then copy L31 to L32, but if K33 is empty then stop)
Im sorry if this is a basic question, I have just started working with VBA.
Thank you in advance
Sub kepletmasolos()
Sheets("XTR MSTR").Select
If IsEmpty(Range("K3").Value) = False Then
Range("L2").Copy Range("L3")
End If
End Sub
Here is one way, using a Do loop:
Sub kepletmasolos()
Dim r As Long: r = 3
With Sheets("XTR MSTR")
Do Until IsEmpty(.Cells(r, "K"))
'.Cells(r, "L").Value = .Cells(r - 1, "L").Value
.Cells(r - 1, "L").copy .Cells(r, "L")
r = r + 1
Loop
End With
End Sub
new to VBA myself, Just thought i would through my idea in?
row = where you would start, let me know what you think.
Sub kepletmasolos()
Dim Row As Long
Row = 1
Start:
With Sheets("XTR MSTR")
If Not isEmpty(.Cells(Row, "K")) Then
.Cells(Row, "L").Copy .Cells(Row + 1, "L")
Row = Row + 1
GoTo Start
Else
End If
End With
End Sub
Related
I found a code that I use to insert rows based on the cell value:
Sub Add_Rows()
Dim r As Long
Application.ScreenUpdating = False
For r = Range("F" & Rows.count).End(xlUp).Row To 1 Step -1
If Cells(r, "F").Value > 0 Then Rows(r + 1).Resize(Cells(r, "F").Value).Insert
Next r
Application.ScreenUpdating = True
End Sub
But I also need to copy the value of the cell with the same index as "F" into the inserted rows:
How can I modify the code so that rows are inserted based on the value of the range F and a value from the range H is inserted into these rows in parallel?
That is, the script should have logic: if the value of "F" is 2, two rows are inserted - and the value from the index "H" is inserted into these two new rows
In the code that I sent, I manage to insert rows based on the value from the index "F", but I can't supplement the code so that the value from the index H is inserted for each new row
Please tell me how to modify the code?
Thanks
I added a line after the .Insert that assigns the value to the "H" column of those new rows. I used the same dynamic range ideas that .Insert used to find the correct range for those new rows.
Sub Add_Rows()
Dim r As Long
Application.ScreenUpdating = False
For r = Range("F" & Rows.Count).End(xlUp).Row To 1 Step -1
If Cells(r, "F").Value > 0 Then
Rows(r + 1).Resize(Cells(r, "F").Value).Insert
Cells(r + 1, "H").Resize(Cells(r, "F").Value).Value = Cells(r, "H").Value
End If
Next r
Application.ScreenUpdating = True
End Sub
Try something like this:
Sub Add_Rows()
Dim r As Long
Application.ScreenUpdating = False
For r = Range("F" & Rows.Count).End(xlUp).Row To 1 Step -1
If Cells(r, 5).Value > 0 Then
Rows(r + 1).Resize(Cells(r, 5).Value).Insert
' insert h value
Cells(r + 1, 7).Value = Cells(r, 7).Value
End If
Next r
Application.ScreenUpdating = True
End Sub
New member here trying to fathom what might be wrong with the following code...
I am trying to copy rows from "A5" to the last row and columns A:L except columns "C & D" when C = "Y" but not getting anything when execute Macro and debug now giving much away (although I am new to this :-)). Any ideas or help would be appreciated.
Private Sub UpdateImportFile_Click()
Dim count As Long
count = WorksheetFunction.CountA(Range("A5", Range("A5").End(xlDown)))
For i = 5 To count
If Worksheets("Case Entry").Cells(i, 3).Value = "Y" Then
Worksheets("Case Entry").Rows(i).Columns(1, 2).Copy
Worksheets("Import File").Activate
Worksheets("Import File").Cells("A2").Select
ActiveSheet.PasteSpecial xlPasteValues
End If
Next
Application.CutCopyMode = False
ThisWorkbook.Worksheets("Case Entry").Cells(1, 1).Select
End Sub
Try this:
Private Sub UpdateImportFile_Click()
Dim count As Long
count = WorksheetFunction.CountA(Range("A5", Range("A5").End(xlDown)))
With Worksheets("Case Entry")
For i = 5 To count + 4
If .Cells(i, 3).Value = "Y" Then
Worksheets("Import File").Cells(i, 1).Resize(1, 2).Value = .Cells(i, 1).Resize(1, 2).Value
End If
Next
End With
End Sub
I'm creating a macro loop that takes the value from column A and adds it as a prefix to the rest of the cells after column D on that row. When it reaches an empty cell, it then goes to the next row and repeats the process until column A cell is empty. I have used this code which works on the first row, but I can't seem to get it to loop to the other rows.
Sub FLOC
Dim I as Integer
Dim j as Integer
I=4
j=1
'Check that Column A is not empty to stop the Loop
While Not IsEmpty(Cells(j, 1))
If Not IsEmpty(Cells(j,i)) Then
'Select Column D in that row
Cells(j, i).Select
'Add the prefix from Column A to the rest of the Cells on the row
ActiveCell.Value = Cells(1, j).Value & ActiveCell.Value
i = i + 1
'When a empty cell is reached move the ActiveCell to next row, Column D.
Else
i = 4
j = j + 1
Endif
Wend
Sub End
Any help on the right path would be appreciated.
Thanks for the help I solved this with
Sub FLO2 ()
Dim i As Double
Dim j As Double
Dim FLOC As String
j = 1
i = 4
FLOC = Cells(j, 1)
While Not IsEmpty(FLOC)
If Not IsEmpty(Cells(j, i)) Then
Cells(j, i).Select
ActiveCell.Value = Cells(j, 1).Value & ActiveCell.Value
i = i + 1
Else
i = 4
j = j + 1
End If
Wend
Sub End
This is the macro i am using, it looks at a field (AS) and then depending on the number in that column it will create the same amount of rows underneath. So for example if AS has '4' it will create 4 rows containing the number 4.
I need an amendment to this so that these rows will show 1-4, 2-4, 3-4, 4-4
Sub addlabels()
Dim r As Long
For r = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(r, "AS") > 1 Then
Cells(r, 1).EntireRow.Copy
Cells(r + 1, 1).EntireRow.Resize(Cells(r, "AS").Value - 1).Insert shift:=xlDown
End If
Next r
End Sub
Here is an example image of how i need the column to display at the moment it just simply copies from the top field http://i.stack.imgur.com/p8bl8.png
May be you can try like this:
Considering the field("AS") is in cell a1 i've used the following code:
Sub addinglabels()
Dim i As Integer
cellvalue = ActiveSheet.Range("A1").Value
If (cellvalue > 1) Then
For i = 1 To cellvalue
Cells(i + 1, 1).Value = i & "--" & cellvalue
Next i
End If
End Sub
I'm trying to work out how to write a Macro to replace the current Excel formula I'm using. I've tried experimenting with cell values and offsets but my knowledge of VBA is minimal. What I need it to do is to turn a single column list like this:
Cell 1
Cell 2
Cell 3
Cell 4
Cell 5
Cell 6
Into a two-column list like this:
Cell 1 Cell 2
Cell 3 Cell 4
Cell 5 Cell 6
I feel as if it should be pretty simple to achieve, but I want to avoid blank spaces and a loop will probably be required as the length of the list is likely to change each time the macro is run. Can anybody help?
I managed to work out how to do it:
Sub splitColumn()
Range("A1").Select
Do
ActiveCell.Offset(1, 0).Select
If IsEmpty(ActiveCell.Offset(-1, 1)) Then
ActiveCell.Offset(-1, 1).Value = ActiveCell
ActiveCell.EntireRow.Delete
End If
Loop Until IsEmpty(ActiveCell)
End Sub
May be you can try with the following code:
But its a bit too long...I think it may help you in providing some ideas...
Sub Splitting()
Dim i, j, k, l As Integer
RowCount = ThisWorkbook.Sheets("Sheet1").UsedRange.Rows.Count
For i = 1 To RowCount Step 2
For j = 1 To 1
Cells(i, j + 1).Value = Cells(i, j).Value
Cells(i, j + 2).Value = Cells(i + 1, j).Value
Next j
Next i
Call Removeblanks
End Sub
Sub Removeblanks()
RowCount = ThisWorkbook.Sheets("Sheet1").UsedRange.Rows.Count
For i = 1 To RowCount
For j = 1 To 1
If (Cells(i, j + 1).Value = "") Then
Cells(i, j + 1).Delete
Cells(i, j + 2).Delete
End If
Next j
Next i
End Sub