I have data like in the picture below:
I need to (with a macro) arrange the data so that every row with a number after ELEVATION\AZIMUTH be in the first row, like in picture:
I have a lot of rows like this data. Maybe any one can help?
This is not tested. you can give it a try. the below can be written in diff way as well.
Sub test1()
Dim LastRow, DataCount, temp As Double
i = 1
LastRow = 1
Do While LastRow <> 0
Range("A" & i).Select
If ActiveCell.Value = "ELEVATION\AZIMUTH" Then
'Cut all three row and paste
DataCount = Application.WorksheetFunction.CountA(Range(i & ":" & i))
Range("A" & ActiveCell.Row + 1, "I" & ActiveCell.Row + 1).Cut ActiveCell.Offset(0, DataCount)
Range("A" & ActiveCell.Row + 2, "I" & ActiveCell.Row + 2).Cut ActiveCell.Offset(0, DataCount * 2)
Range("A" & ActiveCell.Row + 3, "I" & ActiveCell.Row + 3).Cut ActiveCell.Offset(0, DataCount * 3)
Else
LastRow = Application.WorksheetFunction.CountA(Range("A" & i, "A" & i + 10))
End If
i = i + 1
Loop
End Sub
This can also be done without the use of macros.
I am assuming your last column where data is there is column I and the row number is 11. You want to fill all cells in row 11 after column I, i.e. J11,K11.... with values right below I11
You could do this, paste in J11
J11=INDEX($I$11:$I$1000,COLUMN(B1),1)
Drag the formula across the row and you should get your desired output
Related
I need a macro that will apply the below-mentioned formula in column J if the value of a cell in column C is "Hits_US" and the value of a cell in column D is "harry". Below is the formula
=((Column G*32)+(Column H*28)+300)/60
Please note that there will be other values in column J. So, only if the condition is met, the formula has to be applied.
I tried to do this in parts. I first tried to multiply the value in column G by 32. But it did not work.
For i = 1 To 10
If Sheets(1).Range("C" & i).Value = "Hits_US" And Range("D" & i).Value <> "harry" Then
Cells(i, 10) = Cells(i, 7) * 32
End If
Next i
You should be able to avoid a loop
Sheets(1).Range("J1:J10").Formula = "=IF(AND(C1=""Hits_US"",D1=""Harry""),(G1*32+H1*28+300)/60,"""")"
For all rows in J, based on how many entries are in column C
With Sheets(1)
.Range("J1:J" & .Range("C" & Rows.Count).End(xlUp).Row).Formula = "=IF(AND(C1=""Hits_US"",D1<>""Harry""),(G1*32+H1*28+300)/60,"""")"
End With
If you want to leave a formula in cells then I'd go with R1C1 notation:
Sheets(1).Range("J1:J10").FormulaR1C1 = "=IF(AND(RC3=""Hits_US"",RC4=""harry""),(RC7*32+RC8*28+300)/60,"""")"
While if you want to leave only the formula results then you have to possibilities:
have formulas do the math and then leave only values
With Sheets(1).Range("J1:J10")
.FormulaR1C1 = "=IF(AND(RC3=""Hits_US"",RC4=""harry""),(RC7*32+RC8*28+300)/60,"""")"
.Value = .Value
End With
have VBA do the math and write its results directly
With Sheets(1)
For i = 1 To 10
If .Range("C" & i).Value = "Hits_US" And .Range("D" & i).Value = "harry" Then
.Cells(i, 10) = (.Cells(i, 7) * 32 + .Cells(i, 8) * 28 + 300) / 60
End If
Next
End With
I am new to programming and |I would like some help with the following:
I need a code that when it reads in cells(x,3)="wall" then for every next row until it "hits" another element, that it to say until cells(x+1,3)<>"", it copies the values of cells A:E of that row to another sheet if these satisfy a specific condition. The code will somehow start like that:
If Cells(x, 3) = "wall" Then
Do Until Cells(x + 1, 2) <> ""
If Cells(x + 1, 4) <> "m2" Then
......
x=x+1
Loop
I would like some help with the part of the code in between.
Try the code below. Make sure that it's looking at the correct cells for your conditions.
Option Explicit
Sub copyCells()
'Some variables to keep track of where we are on the sheets
Dim x As Integer
Dim lastRow As Integer
Dim i As Integer
Sheets("Sheet1").Select
Range("A1").Select
'I used 18 rows in my test set. You'll want to change this to fit your data.
lastRow = 18
i = 1
For x = 1 To lastRow
'Check for the first condition
If Cells(x, 3) = "wall" Then
'Move to the next row
x = x + 1
'Check that this is a row we want to copy
'and we haven't reached the end of our data
Do While Cells(x, 2) = "" And x < lastRow
'Check the second condition
If Cells(x, 4) <> "m2" Then
'Copy and paste to the second sheet
Range("A" & x & ":E" & x).Copy
Sheets("Sheet2").Select
Range("A" & i).Select
ActiveSheet.Paste
'Increment i to keep track of where we are on the second sheet
i = i + 1
End If
'Go back to checking the first sheet
x = x + 1
Sheets("Sheet1").Select
Range("A" & x).Select
Loop
End If
Next x
Application.CutCopyMode = False
End Sub
I have spent some trying getting my code to work and looking through various example but still cant get it to work properly.
I have a table where I want to loop through all rows and if "Pro" found in column B , copy the whole row and paste it once either underneath the row or at the very bottom(ideally) (Picture attached before and after the code)
I tried with the below code but all it does is finding the first instance of "Pro" in column B and copying same row until range 50 reaches:
sub Loop()
Dim i As Long
For i = 1 To 50
Range("B" & i).Select
If Range("B" & i).Value = "Pro" Then
Rows(i).EntireRow.Copy
Rows(i + 1).Insert Shift:=xlDown
End If
Next i
End Sub
I tried with (For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row )
as well, defining last column but same thing happens(end up copying same row over and over again until the specified range finish).
If this will be too easy, I want for a copied row to have a value in Column A changed as well from as an exaple Req2 to Req2Pro
https://i.stack.imgur.com/AnWNH.jpg
Edit this line:
Rows(i).EntireRow.Copy
Rows(i + 1).Insert Shift:=xlDown
With:
Rows(i + 50).Value = Rows(i).Value
Range("A" & i + 50).value = Range("A" & i).value & "Pro"
This is it in the code:
Sub testloop()
Dim i As Long
Dim Find_last_row as long
Find_last_row = cells(rows.count,1).end(xlup).row
For i = 1 To Find_last_row
If Range("B" & i).Value = "Pro" Then
Rows(i + Find_last_row).Value = Rows(i).Value
Range("A" & i + Find_last_row).value = Range("A" & i).value & "Pro"
End If
Next i
End Sub
Run the for-next loop descending, e.g,
for row = 50 to 1 step -1
...
.cells(row+1,1)=.cells(row,1) & "Pro"
next
The issue is that it finds a "Pro" and inserts a copy one row down, then advances the row counter and finds the copy. By running from the bottom up instead, the rows created have already been passed
edited to add column A update
Sub Loop()
Dim i As Long
For i = 50 To 1 step -1
Range("B" & i).Select
If Range("B" & i).Value = "Pro" Then
Rows(i).EntireRow.Copy
Rows(i + 1).Insert Shift:=xlDown
Range("A" & i + 1).Value = Range("A" & i).Value & "Pro"
End If
Next i
End Sub
Edited to add the above
I have this code for pasting the "sum" formula at the same row but in diferent columns (actually, is not this exactly formula, the "sum" was used only for explaining)
for i = 1 to 100
Cells(2, (1 + 5 * (i - 1))).Formula = "=sum($A$1:$E$1)"
Next
But, I need this formula to change every iteration, like the cell that it is pasted. Then, the Cell "A1" (for i = 1) must change to "F1" at the same moment as "E1" change to "J1" when i = 2.
How can I make this loop through columns?
Thanks in advance!
Luiz
For i = 1 to 100
Cells(2, 5 + ((i - 1) * 5)).FormulaR1C1 = "=SUM(R[-1]C[-4]:R[-1]C[0])"
Next
Try below code :
Dim colChar As String, colChar5 As String
For i = 1 To 100 Step 5
colChar = Split(Cells(, i).Address, "$")(1)
colChar5 = Split(Cells(, i + 4).Address, "$")(1)
Cells(2, i).Formula = "=sum(" & colChar & "1:" & colChar5 & "1)"
Next
I have an excel sheet of which the data was jumbled: for example, the data that should have been in Columns AB and AC were instead in Columns B and C, but on the row after. I have the following written which moved the data from B and C to AB and AC respectively:
Dim rCell As Range
Dim rRng As Range
Set rRng = Sheet1.Range("A:A")
i = 1
lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
For Each rCell In rRng.Cells
If rCell.Value = "" Then
Range("AB" & i) = rCell.Offset(0, 1).Value
rCell.Offset(0, 1).ClearContents
End If
i = i + 1
If i = lastRow + 1 Then
Exit Sub
End If
Next rCell
End Sub
However, it doesn't fix the problem of the data being on the row BELOW the appropriate row now that they are in the right columns. I am new to VBA Macros so I would appreciate any help to make the data now align. I tried toggling the Offset parameter (-1,0) but it's not working.
Try something like this?
For i = Lastrow To 1 Step -1
' move data into cell AA from Cell A one row down
Cells(i, 27).Value = Cells(i + 1, 1).Value
Next
You don't need to loop through the range to accomplish what you're trying to do.
Try this instead:
Sub MoveBCtoAbAcUpOneRow()
Dim firstBRow As Integer
Dim lastBRow As Long
Dim firstCRow As Integer
Dim lastCRow As Long
' get the first row in both columns
If Range("B2").Value <> "" Then
firstBRow = 2
Else
firstBRow = Range("B1").End(xlDown).Row
End If
If Range("C2").Value <> "" Then
firstCRow = 2
Else
firstCRow = Range("C1").End(xlDown).Row
End If
' get the last row in both columns
lastBRow = Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row
lastCRow = Range("C" & ActiveSheet.Rows.Count).End(xlUp).Row
' copy the data to the correct column, up one row
Range("B" & firstBRow & ":B" & lastBRow).Copy Range("AB" & firstBRow - 1)
Range("C" & firstCRow & ":C" & lastCRow).Copy Range("AC" & firstCRow - 1)
' clear the incorrect data
Range("B" & firstBRow & ":B" & lastBRow).ClearContents
Range("C" & firstCRow & ":C" & lastCRow).ClearContents
End Sub
Notes:
If the shape of data in each column is the same, you don't need to
find the first and last row for each. You'll only need one variable for each and one copy operation instead of 2.
Make sure you set variable declaration to required.
(Tools -> Options -> Require Variable Declaration) You may already be doing this, but I couldn't tell because it looks like the top of your Sub got truncated.