I am trying to number column A in increments by 1, based on how many rows are in column B Example of my Excel sheet
The code I currently have does this, but the top number does not end up being 1. I need to start with 1 at the top and count down.
Sub SecondsNumbering()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Data Formatted")
Dim LastRow As Long
Dim i As Long
With ws
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = 6 To LastRow
.Cells(i, 1).Value = i - 1
Next
End With
End Sub
With this, I am counting the number of rows in the column.
Edit: When I do the value 7 for i, so that it starts at 6 (which is where I want data to start) this is what I get.
How about...
Option Explicit
Sub Test()
Dim lCntr As Long
lCntr = 6
Do
If (Cells(lCntr, 2) <> "") Then Cells(lCntr, 1) = lCntr - 5
lCntr = lCntr + 1
Loop Until Cells(lCntr, 2) = ""
End Sub
HTH
Related
In my vba code below I am trying to delete to specific colors from a row. Right now I would like to combine 2 if statements into 1 if statement. Right now my code below is working but is inefficient if more colors are added. Look for the if statements regarding blue and red for this problem.
Sub collapse_columns()
Dim x As Integer
For x = 1 To 4
collapse_column x
Next
End Sub
Sub collapse_column(column_number As Integer)
Dim row As Long
Dim s As Worksheet
Dim last_row As Long
Set s = ActiveSheet ' work on the active sheet
'Set s = Worksheets("Sheet1") 'work on a specific sheet
last_row = ActiveSheet.Cells(s.Rows.Count, column_number).End(xlUp).row
For row = last_row To 1 Step -1
If Cells(row, column_number).Value = "red" Then Cells(row, column_number).Delete xlUp
Next
For row = last_row To 1 Step -1
If Cells(row, column_number).Value = "blue" Then Cells(row, column_number).Delete xlUp
Next
End Sub
When I have many possible values that can trigger the same code, I like to use a string to hold the values, then search the string to find a match as follows:
Sub collapse_column(column_number As Integer)
Dim row As Long
Dim s As Worksheet
Dim last_row As Long
Set s = ActiveSheet ' work on the active sheet
'Set s = Worksheets("Sheet1") 'work on a specific sheet
last_row = ActiveSheet.Cells(s.Rows.Count, column_number).End(xlUp).row
Dim colors_to_delete As String
colors_to_delete = ",red,blue," ' be sure to keep the leading and trailing commas
For row = last_row To 1 Step -1
If InStr(1, colors_to_delete, "," & Cells(row, column_number).Value & ",") > 0 Then Cells(row, column_number).Delete xlUp
Next
End Sub
I need to create a column with the difference between a column and a cell (A3) in a loop.
In the picture I would for example like to know impact 1 with the H3 to a H.. = scenario(F3 to F...) - A3 and impact 2= Scenario2(G3...G)-A3 for x years (B3) for example.
I started with an if loop but I struggled to loop the whole column.
Sub Lab1()
Dim i As Integer
If i <= Range("B3").Value Then
Range("H3").Value = Range("F3").Value - Range("A3").Value
Range("J3").Value = Range("G3").Value - Range("A3").Value
End If
i = 2020 + Range("B5").Value
End Sub
I'm a little iffy on where column P from your code comes into play with your screenshot, but this should roughly do what you're looking for I think. Let us know if you run into any issues!
Sub loop1()
'define variables to work with
Dim ws As Worksheet
Dim interCol As Long, scen1Col As Long, impact1Col As Long
Dim firstRow As Long, lastRow As Long
Dim rng As Range
Dim intervention As Long, scenario As Long
Dim i As Long
'define current worksheet
Set ws = ActiveSheet
'define column numbers
interCol = 1 'A
scen1Col = 6 'F
impact1Col = 8 'H
'define start row
firstRow = 3
'end row is the last non-blank cell in Scenario 1 column
lastRow = ws.Cells(ws.Rows.Count, scen1Col).End(xlUp).Row
'loop from first row to last row
For i = firstRow To lastRow
'define cell to update
Set rng = ws.Cells(i, impact1Col)
'intervention doesn't change from row to row
intervention = ws.Cells(firstRow, interCol)
'scenario varies from row to row
scenario = ws.Cells(i, scen1Col)
'update target cell with calculation
rng = scenario - intervention
Next i
End Sub
I am working on a project where I need to populate the column headings with incremental values (increased by 1) until the Last Column.
The code is working OK but the value in the column headings is NOT increased by 1. It is just taking the original value and place it over all columns.
Could you help me?
My code so far:
Sub LastColumn_PopulateHeadings()
'Declare variable for Last row (Prior FY)
Dim LastColumn As Integer
Dim i As Integer
'Find the last Column used
LastColumn = Range("XFD4").End(xlToLeft).Column
'populate headings with column values UNTIL LAST COLUMN
' Loop to populate the heading until LAST column
i = 8
Do While i < LastColumn
'MsgBox (LastColumn)
Cells(4, i).Value = Cells(4, i).Value + 1
i = i + 1
Loop
End Sub
I find your code a little strange, but probably i am missing something. Anyway this one should work:
Sub LastColumn_PopulateHeadings()
'Declare variable for Last row (Prior FY)
Dim LastColumn As Integer
Dim i As Integer
Dim IntCounter01 As Integer '<<<<<<ADDED LINE (1 of 3)
'Find the last Column used
LastColumn = Range("XFD4").End(xlToLeft).Column
'populate headings with column values UNTIL LAST COLUMN
' Loop to populate the heading until LAST column
i = 8
IntCounter01 = 1 '<<<<<<ADDED LINE (2 of 3)
Do While i < LastColumn
'MsgBox (LastColumn)
Cells(4, i).Value = IntCounter01
i = i + 1
IntCounter01 = IntCounter01 + 1 '<<<<<<ADDED LINE (3 of 3)
Loop
End Sub
I took your code and added 3 lines. You could also use a For-Next cycle instead of using a Do-While-Loop cycle since you already know your maximal value. Something like:
For i = i To LastColumn - 1
Cells(4, i).Value = IntCounter01
IntCounter01 = IntCounter01 + 1
Next
You could also use a formula to cover your range instead of picking each cell one by one. Like this:
Sub LastColumn_PopulateHeadings()
'Declarations.
Dim IntFirstColumn As Integer
Dim IntLastColumn As Integer
Dim IntRow As Integer
Dim IntFirstValue
Dim RngRange01 As Range
'Setting variables.
IntFirstValue = 1
IntRow = 4
IntFirstColumn = 8
IntLastColumn = Range("XFD4").End(xlToLeft).Column
'Setting first value in the first cell.
Cells(IntRow, IntFirstColumn).Value = IntFirstValue
'Setting RngRange01.
Set RngRange01 = Range(Cells(IntRow, IntFirstColumn + 1), Cells(IntRow, IntLastColumn - 1))
'Setting formulas in RngRange01.
RngRange01.FormulaR1C1 = "=RC[-1]+1"
'Copy-pasting the values in RngRange01.
RngRange01.Value = RngRange01.Value
End Sub
I know that this row is wrong:
ws.Cells(i, "D").Resize(39).Rank_Eq(2, "2:40", 1) = ws.Cells(Rows.Count, "E").End(xlUp).Offset(1, 0)
I want to rank the whole column D in column E. The numbers should be "grouped" in 39 numbers.
Private Sub CommandButton2_Click()
Dim lrow As Long
Dim i As Long
Dim ws As Worksheet
Set ws = ActiveWorkbook.Worksheets("Sheet1") 'Set the name of the sheet
lrow = ws.Cells(Rows.Count, "D").End(xlUp).row 'Find the last row in column D
For i = 2 To lrow Step 39 'Loop every group (group of 13 rows) in column D
ws.Cells(i, "D").Resize(39).Rank_Eq(2, "2:40", 1) = ws.Cells(Rows.Count, "E").End(xlUp).Offset(1, 0)
Next i
End Sub
I think the code will do what you want. Please pay attention to the constants at the top which you have to set to suit your needs.
FirstDataRow - your data seem to start in row 2. So, don't change.
GroupSize - I tested groups of 3 rows. I think you want groups of 39 rows. Change it.
TgtClm - Your data are in column 4 (column D). No need to change now.
Once you have set these 3 constants the code is ready to run. Please try it.
Private Sub CommandButton2_Click()
' 034
Const FirstDataRow As Long = 2
Const GroupSize As Long = 3 ' change to suit
Const TgtClm As Long = 4 ' Target Column (4 = column D)
' the output will be in the adjacent column
Dim Ws As Worksheet
Dim Rng As Range ' cells in one group
Dim lRow As Long ' last used row
Dim Rstart As Long ' first row in group range
Dim Rend As Long ' last row in group range
Set Ws = ActiveWorkbook.Worksheets("Sheet1") 'Set the name of the sheet
lRow = Ws.Cells(Ws.Rows.Count, TgtClm).End(xlUp).Row 'Find the last used row
Rstart = FirstDataRow
Do
Rend = Application.Min(Rstart + GroupSize - 1, lRow)
With Ws
Set Rng = .Range(.Cells(Rstart, TgtClm), .Cells(Rend, TgtClm))
End With
Rng.Offset(0, 1).Formula = "=RANK(" & Rng.Cells(1).Address(0, 1) & _
"," & Rng.Address & ",0)"
Rstart = Rend + 1
If Rstart > lRow Then Exit Do
Loop
End Sub
Note that the final 0 in the RANK formula (here: & Rng.Address & ",0)") instructs to rank in desscending order, meaning the highest number will get the lowest rank (100 = 1, 90 = 2 etc). Change to 1 if you need the opposite order.
I do not know this topic so well, but on the webpage
https://learn.microsoft.com/en-us/office/vba/api/excel.worksheetfunction.rank_eq
Is written that expression.Rank_Eq (Arg1, Arg2, Arg3), and the
expression A variable that represents a WorksheetFunction object.
In your code it looks like a Range object.
My code loops through rows and columns and performs an action. I want to loop to the first empty column, however,
my code keeps looping past this column. My sheet currently looks something like this:
A----------1----------blank---------A---------1
B----------2----------blank---------C---------4
C----------3----------blank---------W---------2
In the above example, I want to loop from k = 1 to the first empty column, which is k = 3 (i.e. only extract data from the first 2 columns then stop the loop).
This is my current code:
Option Explicit
Sub exitemptycolumn()
Dim lastcolumn As Long
Dim lastrow As Long
Dim sh As Worksheet
Dim rng As Range
Set sh = Sheets("sheetname")
lastcolumn = sh.Cells(1, Cells.Columns.Count).End(xlToLeft).Column
lastrow = sh.Cells(Rows.Count, 1).End(xlUp).Row
For k = 7 to lastcolumn
for j = 1 TO lastrow
set rng = sh.Range(columns(1), Columns(k))
If Application.WorksheetFunction.CountA(sh.Cells(1, k).EntireColumn) = 0 then Exit For
'rest of code
Next j
Next k
End Sub
To answer the question, you want to end your loop through columns as soon as the column is completely empty.
We can use Application.WorksheetFunction.CountA to do the check like so:
For k = 7 to lastcolumn
set rng = sh.Range(columns(1), Columns(k))
If Application.WorksheetFunction.CountA(sh.Cells(1, k).EntireColumn) = 0 then Exit For
Next k