Changing the Columns through a loop - VBA - vba

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

Related

Excel, drag 3 different commands but only increase them by one not 3?

I want to get a lot of data from Sheet1 to Sheet2 but when I pull a command to the right it should only increase the "C" to a "D" every third row.
Because I have 3 commands to pull to the right and all should just increade by one not by 3.
A1 looks like this:
=WENN(Sheet1!C3>0;Sheet1!C$2;"")
B1 like this:
=WENN(Sheet1!C3>0;Sheet1!$A3;"")
C1 like this:
=WENN(Sheet1!C3>0;Sheet1!C3;"")
When I pull it to the right it they change like this:
=WENN(Sheet1!F3>0;Sheet1!F$2;"")
=WENN(Sheet1!F3>0;Sheet1!$A3;"")
=WENN(Sheet1!F3>0;Sheet1!F3;"")
But I want:
=WENN(Sheet1!D3>0;Sheet1!D$2;"")
=WENN(Sheet1!D3>0;Sheet1!$A3;"")
=WENN(Sheet1!D3>0;Sheet1!D3;"")
I hope you know what I mean.
Is there any way to do this?
It is possible with VBA:
What you entered in Excel in VBA language is the following:
Range("A1").Formula = "=IF(Sheet1!C3>0,Sheet1!C$2,"""")"
Range("B1").Formula = "=IF(Sheet1!C3>0,Sheet1!$A3,"""")"
Range("C1").Formula = "=IF(Sheet1!C3>0,Sheet1!C3,"""")"
If now you put a small loop you can add 1 to the Column "C" each time you reenter your formula. I used a small Function for this (from Function to convert column number to letter?)
Sub Macro1()
Dim k As Integer
k = 1
Range("A1").Formula = "=IF(Sheet1!C3>0,Sheet1!C$2,"""")"
Range("B1").Formula = "=IF(Sheet1!C3>0,Sheet1!$A3,"""")"
Range("C1").Formula = "=IF(Sheet1!C3>0,Sheet1!C3,"""")"
For k = 1 To 10 ' Here change 10 into whatever you need.
Cells(1, 3 * k + 1).Formula = "=IF(Sheet1!" & Col_Letter(3 + k) & "3>0,Sheet1!" & Col_Letter(3 + k) & "$2,"""")"
Cells(1, 3 * k + 2).Formula = "=IF(Sheet1!" & Col_Letter(3 + k) & "3>0,Sheet1!$A3,"""")"
Cells(1, 3 * k + 3).Formula = "=IF(Sheet1!" & Col_Letter(3 + k) & "3>0,Sheet1!" & Col_Letter(3 + k) & "3,"""")"
Next k
End Sub
Function Col_Letter(lngCol As Long) As String
Dim vArr
vArr = Split(Cells(1, lngCol).Address(True, False), "$")
Col_Letter = vArr(0)
End Function
Hope it helps
If you want a formula based solution
A1:
=IF(INDIRECT(CONCATENATE("Sheet1!";LEFT(SUBSTITUTE(ADDRESS(1;(COLUMN(A:A)+2)/3+2);"$";"");1);"3"))>0;INDIRECT(CONCATENATE("Sheet1!";LEFT(SUBSTITUTE(ADDRESS(1;(COLUMN(A:A)+2)/3+2);"$";"");1);"$2"));"")
B1:
=IF(INDIRECT(CONCATENATE("Sheet1!";LEFT(SUBSTITUTE(ADDRESS(1;(COLUMN(A:A)+2)/3+1);"$";"");1);"3"))>0;Sheet1!$A3;"")
C1:
=IF(INDIRECT(CONCATENATE("Sheet1!";LEFT(SUBSTITUTE(ADDRESS(1;COLUMN(C:C)/3+2);"$";"");1);"1"))>0;INDIRECT(CONCATENATE("Sheet1!";LEFT(SUBSTITUTE(ADDRESS(1;COLUMN(C:C)/3+2);"$";"");1);"1"));"")
I can't guarantee that there's no mistake as I don't have your workbook, however when I made a test of the formula it worked fine for me.

Edit value of cells in a specific column if a condition is not met using Excel VBA

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

Excel data from colum to row

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

Run brute force on a column to identify if the values cross over a point using VBA

I am wondering how I can write a VBA code to check if my data crosses over a certain point of interest. I have a column of approx. 40,000 data points that linearly increase and decrease (i.e 0 to 10 and then back down from 10 to 0). I want to identify when the points cross over a value and perform interpolation on corresponding data values. For example, I would like to write a code that will pick every time my data set crosses 4.1, and perform interpolation on the corresponding cell values in another column.
This is what I have tried so far
'Calculate how many data points are present in worksheet
Dim lastRow As Long
lastRow = Range("B" & Rows.Count).End(xlUp).Row
'Identify the data colum as pot1 throughout code
Set pot1 = Range("N14:N" & lastRow)
Dim i As Integer
'data starts from line 14 of worksheet
For i = 14 To lastRow
'check to see if the cell above contains text, if it does, line a tells it to skip that cell and move to next one
If WorksheetFunction.IsNumber(Cells(i - 1, 2)) = False Then GoTo a
a:
i = i + 1
GoTo b
'check if two vertically adjacent cells have crossed over 4.1
b:
If Cells(i, 2) > 3.995 & Cells(i + 1, 2) < 4.01 Then
' interpolate the value if they have crossed 4.1
Range("S1")=WorksheetFunction.Forecast(4.1, Cells(i:i+1,2), Range("D" i ":D" i+1)
I am stuck at using forecast function as I currently don't know how I can tell excel to pick a block of cells inside a loop.
Here's how you would do the looping:
Sub Tester()
Dim sht As Worksheet, lastRow As Long, xvals, yvals, r As Long
Dim th As Double, y1, y2, x1, x2
Set sht = ActiveSheet
lastRow = sht.Range("B" & Rows.Count).End(xlUp).Row
'assumes y vals in "B" and x vals in "N"
'adjust as rtequired...
yvals = sht.Range(sht.Cells(14, "B"), sht.Cells(lastRow, "B"))
xvals = sht.Range(sht.Cells(14, "N"), sht.Cells(lastRow, "N"))
th = 4.1
For r = 1 To UBound(yvals) - 1
y1 = yvals(r, 1)
y2 = yvals(r + 1, 1)
'pair of points crosses the threshold?
If IsNumeric(y1) And IsNumeric(y2) Then
If (y1 < th And y2 > th) Or (y1 > th And y2 < th) Then
x1 = xvals(r, 1)
x2 = xvals(r + 1, 1)
'*************
'calculate the intercept
'*************
End If
End If
Next r
End Sub
First of all, you forgot & in your forecast formula :
Range("S1")=Worksheetfunction.Forecast(4.1, , Range("D" & i ":D" & i+1)
Secondly, Forecast function requires three arguments - you only provide two of them. Please take a look here for more info on Forecast function.
There are a few problems with this statement:
Range("S1")=WorksheetFunction.Forecast(4.1, Cells(i:i+1,2), Range("D" i ":D" i+1)
The main problem is you are calling the ranges wrong
Cells(i:i+1,2)
Should be:
Range(Cells(i,2),Cells(i+1,2))
or
Range("B" & i & ":B" & i + 1)
See above for why Range("D" i ":D" i+1) is also wrong.
You also are missing a ')' At the end of the statement.
So Adding it all together:
Range("S1")=WorksheetFunction.Forecast(4.1, Range("B" & i & ":B" & i + 1), Range("D" & i & ":D" & i+1))

Remove / Filter Cell Contents in Microsoft Excel 2013

I am looking for the best way to clean up the cell contents of one particular cell in my spreadsheet. As it exists now, Column D lists a City, State, and High School in the same cell (Screenshot #1). I need to split these values out into 3 unique columns/cells as shown in Screenshot #2. How would I accomplish this?
** Note - The example below is just a sample size. I have thousands of cells to perform this on.
Existing cell format:
New Format (Hopefully):
Use Text-to-Columns "delimited" to split on the comma, then use it again "fixed width" to split the state from the school name (assuming the state is always 2 characters). Clean up spaces with TRIM if required.
Hi something like this should look through all your cells in row D and return the values you are looking for in the next 3 columns; might need a little adjusting
For each cell in Range("D2:D & Range("D2".End(xlDown).Row))
cell.offset(columnOffset:=1) = left(cell,instr(String1:=cell, String2:= ","))
cell.offset(columnOffset:=2) = Mid(cell,instr(String1:=cell, String2:= ",")+1,2)
cell.offset(columnOffset:=3) = right(cell,len(cell)-instr(String1:=cell, String2:= ",")+3)
Next
I tried Jake Duddy's code it contains quite some errors, I do not know if it works. At the same time you can try below code.
Dim LastRow As Long
Dim State_L As String
Dim City_L As String
Dim HS_L As String
LastRow = Range("D" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
City_L = Left(Range("D" & i), InStr(1, Range("D" & i), ",") - 1) ' Getting up to comma
State_L = Mid(Range("D" & i), InStr(1, Range("D" & i), ",") + 1, 2) 'Getting after comma for 2 characters
HS_L = Mid(Range("D" & i), InStr(1, Range("D" & i), ",") + 3, Len(Range("D" & i)) - InStr(1, Range("D" & i), ",")) 'Getting after comma+2 characters upto the end
Range("E" & i).Value = City_L
Range("F" & i).Value = State_L
Range("G" & i).Value = HS_L
Next
Select the cells you wish to process and run this small macro:
Sub ParseData()
Dim r As Range, L As Long, L1 As Long, L2 As Long
For Each r In Selection
t = r.Text
L = Len(t)
L1 = InStr(1, t, ",")
For i = 1 To L
If r.Characters(i, 1).Font.Italic = True Then
L2 = i
Exit For
End If
Next i
r.Offset(0, 1).Value = Mid(t, 1, L1 - 1)
r.Offset(0, 2).Value = Mid(t, L1 + 1, L2 - L1 - 1)
r.Offset(0, 3) = Mid(t, L2)
r.Offset(0, 3).Font.Italic = True
Next r
End Sub
For example: