I would like to copy the following four formulas and paste it in the adjacent four columns with the column reference changing by four everytime. What i mean is copy F4:I4 and paste to J4:M4,N4:Q4...with the "F" cahnging to a "J", then "N", then "Q" and so on until the end of the columns in the sheet.
=IF(AND(F2>=$C$4,F2<=$D$4),TRUE, FALSE)
=IF(AND((F2+6)>=$C$4,(F2+6)<=$D$4),TRUE,FALSE)
=IF(AND((F2+12)>=$C$4,(F2+12)<=$D$4),TRUE,FALSE)
=IF(AND((F2+18)>=$C$4,(F2+18)<=$D$4),TRUE,FALSE)
Am I able to some way loop this going across each column, and after the fourth add four to the numerical value of the cell reference? so instead of F2 and J2 I have Col_ID, Col_ID+4...Not sure how to write this in VBA. Any help would be greatly appreciated.
I used this to merge every four cells above to make the "labels", i'm thinking I can re-use this but not sure how.
Dim Rng As Range
Dim ws As Worksheet
Dim R1 As Long, C1 As Long
Dim R2 As Long, C2 As Long
Dim lastCol As Long
Set ws = ThisWorkbook.Sheets("Dashboard")
R1 = 3: C1 = 6
R2 = 3: C2 = C1 + 3
lastCol = 1
While lastCol < 256
With ws
Set Rng = .Range(.Cells(R1, C1), .Cells(R2, C2))
Application.DisplayAlerts = False
Rng.Merge
Application.DisplayAlerts = True
C1 = C2 + 1
C2 = C1 + 3
lastCol = lastCol + 1
End With
Wend
This will copy a source range to as many groups of four columns as you specify with NumberOfCopies. You didn't say what range you are copying from, so I assumed G3:J3:
Sub CopyCols()
Dim rngSource As Excel.Range
Dim rngTarget As Excel.Range
Dim NumberOfCopies As Long
NumberOfCopies = 12
With ActiveSheet
Set rngSource = .Range("G3:J3")
Set rngTarget = .Range("K3").Resize(rngSource.Rows.Count, NumberOfCopies * 4)
rngSource.Copy Destination:=rngTarget
End With
End Sub
Related
I am very new to Visual Basic and I am trying to do a For loop to create a Date-Task combination for my data and I am stuck. So I have two ranges as below, Dates and Tasks. I need to copy the elements of these ranges to a different sheet as one element of Date followed by all the element in Tasks. I am creating a For loop for this and it justs keep shuffling the correct data in the same cells. It should be like cell B2 is 05-07-2021 and cell C2 is Tipping. Then cell B3 is 05-07-2021, cell C3 is Carrying. Then cell B4 is 05-07-2021, cell C4 is Driving. Then cell B5 is 06-07-2021, cell C5 is Tipping. And so on. How can I do this? I have pasted my sample code here.
Date
Task
05/07/2021
Tipping
06/07/2021
Carrying
07/07/2021
Driving
08/07/2021
09/07/2021
Sub CreateIdentifier()
Dim dateRange As Range
Dim taskRange As Range
Dim LastRow1 As Integer
Dim LastRow2 As Integer
LastRow1 = Sheet6.Cells(Rows.Count, 1).End(xlUp).Row
LastRow2 = Sheet5.Cells(Rows.Count, 4).End(xlUp).Row
Set taskRange = Sheet5.Range(Sheet5.Cells(2, 4), Sheet5.Cells(LastRow2, 4))
Set dateRange = Sheet6.Range(Sheet6.Cells(2, 1), Sheet6.Cells(LastRow1, 1))
Dim datecnt As Range
Dim taskcnt As Range
With Sheet3
For Each datecnt In dateRange
For Each taskcnt In taskRange
.Range("B2") = datecnt.Value
.Range("C2") = taskcnt.Value
Next taskcnt
Next datecnt
End Sub
Increment a variable to switch rows at each iteration
Dim r as Long
r = 2
With Sheet3
For Each datecnt In dateRange
For Each taskcnt In taskRange
.Range("B" & r).Value = datecnt.Value
.Range("C" & r).Value = taskcnt.Value
r = r + 1
Next taskcnt
Next datecnt
End with
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
So I am learning VBA, I know how to program on Matlab and some C++. I am wondering how I can use the CountA to count all of the cells used on a specific row and only that row. ( I have multiple examples on ranges and columns but none on a Row only).I cannot use a range because I want to use this VBA in the future and this row will have a number of variables changing. I would also like to have the content(text) of those cells moved to another location with no spaces between them because right now they have three spaces between each used cell.
So far I have this code which isn't very much for the countA of the first row
Sub CountNonBlankCells()
Dim numcompanies As Integer
n = Sheet1.CountA(Rows(1))
Worksheets("start on this page").Range("B2") = n
End Sub
I have nothing for the part where I take that data from each cell to another location.
Sure you can use a Range. Your question is pretty broad, but for tutorial purpose ... here's a piece of code that counts the number of nonblank cells in a number of rows and shows you what's in each of them ...
Sub TestCount()
Dim mySht As Worksheet
Dim myRng As Range, oRow As Range
Dim lstRow As Long, lstCol As Long
Dim nUsed As Long
Dim iLoop As Long
Set mySht = Worksheets("Sheet13")
lstRow = mySht.Range("A1").End(xlDown).Row
lstCol = mySht.Range("A1").End(xlToRight).Column
Set myRng = mySht.Range(Cells(1, 1), Cells(lstRow, lstCol))
Debug.Print "Number of Rows is " & myRng.Rows.Count
For Each oRow In myRng.Rows
nUsed = Application.CountA(oRow)
For iLoop = 1 To nUsed
Debug.Print oRow.Cells(1, iLoop)
' assign oRow.Cells(1,iLoop) to something else here
Next iLoop
Next oRow
End Sub
As per your question I am assuming that you want to copy a complete row having blank cells to another location(row) but without blank cells.
I guess this is what you want.
Sub CountNonBlankCells()
Dim CurrentSh As Worksheet, TargetSh As Worksheet
Dim LastColumn As Long, count As Long
Dim MyRange As Range
Dim i As Long, temp As Long
Dim RowNum As Long
Set CurrentSh = ThisWorkbook.Worksheets("Sheet1")
Set TargetSh = ThisWorkbook.Worksheets("Sheet2")
RowNum = ActiveCell.Row
LastColumn = CurrentSh.Cells(RowNum, Columns.count).End(xlToLeft).Column
Set MyRange = CurrentSh.Rows(RowNum)
count = WorksheetFunction.CountA(MyRange)
temp = 1
For i = 1 To LastColumn
If Not IsEmpty(CurrentSh.Cells(RowNum, i)) Then
TargetSh.Cells(RowNum, temp).Value = CurrentSh.Cells(RowNum, i).Value
temp = temp + 1
End If
Next i
End Sub
Above code will copy active row in Sheet1 to Sheet2 at same row number without blank cells.
I have a list of true and false values on sheet 3 column A and a list of codes on sheet 2 Column A. If the value on sheet 3 A5 is = True then I want the value on sheet 2 A5 should be colored red. And If the value on sheet 3 A6 is = True then I want the value on sheet 2 A6 should be colored red. And this should move down along Column A on sheet 2 and sheet 3 until data runs out. So far i have got it to work for the first cell in column A but can not get the For Each loop to work. Any Help would be greatly appreciated.
Sub compare_cols()
Dim myRng As Range
Dim lastCell As Long
'Get the last row
Dim lastRow As Integer
lastRow = ActiveSheet.UsedRange.Rows.Count
'Debug.Print "Last Row is " & lastRow
Dim c As Range
Dim d As Range
Set c = Worksheets("Sheet3").Range("A5:25")
Set d = Worksheets("Sheet2").Range("A5:25")
Application.ScreenUpdating = False
For Each cell In c
For Each cell In d
If c.Value = True Then
d.Interior.Color = vbRed
End If
Next
Next
Application.ScreenUpdating = True
End Sub
A more efficient solution wouldn't necessarily next 2 loops within each other. Instead, loop through the range that you'd like to check, and reference the cells Address property to identify new cells to highlight.
Check the code below and let me know if you understand it
Sub ColorOtherSheet()
Dim wsCheck As Worksheet
Dim wsColor As Worksheet
Dim rngLoop As Range
Dim rngCell As Range
Set wsCheck = Worksheets("Sheet3")
Set wsColor = Worksheets("Sheet2")
Set rngLoop = Intersect(wsCheck.UsedRange, wsCheck.Columns(1))
For Each rngCell In rngLoop
If rngCell.Value = True Then
wsColor.Range(rngCell.Address).Interior.Color = vbRed
End If
Next rngCell
End Sub
If cell C2 value is in the range P2:P25 then paste the value in the matching row of Column T into the same row of Column N.
View here for image.
One way, written as a standalone example and assumes that data is on Sheet1 and transfers the first match. Note that there is no error checking/handling in this example.
Sub xferNum()
Dim ws As Worksheet
Dim srow As Long, erow As Long, scol As Long, srchcol As Long
Dim rsltcol As Long, lucol As Long
Dim fndNo As Range, c As Range, lookrng As Range
Set ws = Sheets("Sheet1")
srow = 2
scol = 3
srchcol = 16
lucol = 20
rsltcol = 14
With ws
erow = .Cells(.Rows.Count, scol).End(xlUp).Row
Set lookrng = .Range(.Cells(srow, scol), .Cells(erow, scol))
For Each c In lookrng
Set fndNo = Columns(srchcol).Find(what:=c.Value)
If Not fndNo Is Nothing Then
.Cells(c.Row, rsltcol).Value = fndNo.Offset(0, lucol - fndNo.Column).Value
End If
Next c
End With
End Sub
In cell N2 put this formula: =IF(C2=P2, T2, "")
Then highlight cell N2 down to N25 and fill down. (CTRL + D).