I have a set of formats in a column (n rows long) that I want to apply to a table (13 cols x n rows). The formats stored in the column are dynamic and based upon the type of data eg currency, %, etc. For example: #,##0;[Red](#,##0);"-" or 0.0%;[Red]0.0%;"-"
I want each row of the table to be formatted any time the column is updated.
Note: I am not interested in conditional formatting.
I originally tried referring directly to rng2 as in row.NumberFormat = rng2 but that seemed to get stuck in a never-ending loop.
Sub formatrows()
Dim rng1 As Range
Dim rng2 As Range
Dim row As Range
Dim i As Integer
Set rng1 = Range("Ac7:ao400")
Set rng2 = Range("d7:d400")
i = 0
Range("AC7").Select
'rng1.ClearFormats
For Each row In rng1.Rows
row.NumberFormat = ActiveCell.Offset(i, -25)
i = i + 1
Next row
End Sub
Here's what I came up with seems to work but rather clunky and I'm sure there's a better way to do this?
Simplifying a bit:
Sub formatrows()
Dim rng1 As Range
Dim row As Range
Set rng1 = Range("Ac7:ao400")
'rng1.ClearFormats
For Each row In rng1.Rows
row.NumberFormat = row.EntireRow.Cells(4).value 'take format from ColD
Next row
End Sub
Related
I want to copy all filled cells starting from C5 to column F of a different worksheet.
I referred to another post: Excel - Combine multiple columns into one column
Modified the code based on my needs.
Sub CombineColumns()
Dim Range1 As Range, iCol As Long, Range2 As Range, Check As Range, wks As Worksheets
Set Range1 = wks("T(M)").Range(Cells(5, 3), Cells(Cells(5, 3).End(xlDown).Row, Cells(5, 3).End(xlToRight).Column))
Set Check = wks("csv").Range("F1")
If IsEmpty(Check.Value) = True Then
Set Range2 = Check
Else
LastRow = wks("csv").Range("F" & Rows.Count).End(xlUp).Row
Set Range2 = wks("csv").Cells(LastRow, 6).Offset(1, 0)
End If
For iCol = 3 To Range1.Columns.Count
wks("T(M)").Range(Cells(5, iCol), Cells(Range1.Columns(iCol).Rows.Count, iCol)).Copy
wks("csv").Range2.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Next iCol
End Sub
But I kept getting the error message
"object doesn't support this method or property"
at the step of pasting. After I tried to qualify all the ranges, It says I didn't set the object variable.
Thank you so much for the help!
How about this?
Sub Transposes()
' Example just for hardcoded data
Dim inputRange As Range
Set inputRange = Sheets("Sheet1").Range("C5:F10").SpecialCells(xlCellTypeConstants)
Dim outputCell As Range
Set outputCell = Sheets("Sheet2").Range("A1")
Dim cell As Range
For Each cell In inputRange
Dim offset As Long
outputCell.offset(offset).Value = cell.Value
offset = offset + 1
Next cell
End Sub
Set the last row in ColumnF to be whatever you want, and if that changes dynamically, just use any one of the multiple techniques out there to find the last cell you need to copy/paste.
I have multi-tables in one sheet, how to collect my interested data from them.
for example, I just need the data of table1 column 3, and table2 column 2.
the size for both tables may be variate. I need collect the data into array for next processing.
Thanks.
You need to find a way to restrict the tables in VBA, i.e. know in which row they start and of how many rows they consist. Because the tables can appear anywhere in the sheet with variate dimensions, there is no straight-forward way of extracting their data.
What I would suggest is to loop from the top to the lastrow of the sheet and on every row check if the table started and then in an inner loop iterate through the table rows until the table ends (i.e. an empty row is encountered).
The code might look similar to this (not tested):
Dim LastRow as Long, i as Long, k as Long
Dim sht as Worksheet
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row 'Assuming the tables start in column A
For i=1 to LastRow
If (sht.Range("A" & i) <> "" Then 'table is encountered
k = i
Do While sht.Range("A" & k) <> ""
... 'Get data from specific column
k = k + 1
Loop
End if
i = k
Next i
Try this (necessary comments are in code):
Option Explicit
Sub CollectData()
Dim table1Address As String, table2Address As String
' here you specify cells that are at the start of a column
table1Address = "B2"
table2Address = "C7"
Dim firstCell As Range, lastCell As Range
Dim table1Data, table2Data As Variant
' determine last cell in column and read whole column at once to an array variable
Set firstCell = Range(table1Address)
Set lastCell = Range(table1Address).End(xlDown)
table1Data = Range(firstCell, lastCell).Value2
Set firstCell = Range(table2Address)
Set lastCell = Range(table2Address).End(xlDown)
table2Data = Range(firstCell, lastCell).Value2
End Sub
I have an Excel sheet abc.xlsm" and I have values in "A1" to "A15" in this sheet. I want to copy till 10th row, and then store all the values in an array using VBA.
As mentioned in the comments, please be more specific in your questions: most questions should have at least some bit of code of what you have tried. At any rate this should work, with a couple extra notions:
Sub copy()
'Declaring an array - if you know the data type you can type is as well
Dim varray As Variant
'Declaring other variables - don't need to be separeted, just for clarity
Dim i As Long, iLenghtArray As Integer, rgData As Range, rgTarget As Range
'This is to dimension your array - you have tell VBA the lenght of it, or use REDIM
ilengtharray = 10
'Setting the range reference
Set rgData = Sheet1.Range("$A$1:$J$1")
'Then set the array = to the range you set above
varray = rgData
'Then you can interate over your array like so:
For i = 1 To UBound(varray, 2)
Debug.Print varray(1, i)
Next
'You can also directly past your array into a suitable range
'Setting destination range:
Set rgTarget = Sheet1.Range("$A$2:$J$2")
rgTarget = varray
End Sub
Ideally, I would have a range selected and then I would run the macro and I want the macro to essentially run a loop to go through each row so I can extract information from each row until it reaches the end of the range.
For example, A6:B9 are selected, first I want to focus on A6:B6. As in I want to be able to find the min value of the two cells for instance, using my MinSelected function(stated below) which requires a selected range which would ideally be A6:B6. And I want to do this for each row until the end of the original range.
Function MinSelected(R As Range)
MinSelected = Application.WorksheetFunction.min(R)
End Function
Is there any way to do this??? Please tell me to clarify anything that's unclear. Thanks in advance.
You can loop through rows - but looping through a variant array is more efficient (for many rows)
variant aray
Dim X
Dim lngCnt As Long
X = Range("A6:B9").Value2
For lngCnt = 1 To UBound(X)
Debug.Print Application.Min(Application.Index(X, lngCnt))
Next
range approach
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Range("A6:B9")
For Each rng2 In rng1.Rows
Debug.Print Application.Min(rng2)
Next
Use a For loop, Rows.Count property, Columns.Count
Dim i as long
For i = 1 to Selection.Rows.Count
For j = 1 To Selection.Columns.Count
Cells(i, j).Value ' Use this to access the value of cell in row i and column j
I have a row of data that changes once a month but it only changes roughly 30 cells out of 90 and every month they are different so I am trying to make a Macro to automate it.
The Macro looks at Cells A2 - B98 and searches for information that matches the Values of H2-I98 and if the values in A match H then it copies what the value is in I and replaces it in B but it doest stop at the end of the row i.e. at row 98 it loops infinatly. So I was hoping someone could find my error so that it wont loop for ever. Thanks
Sub Update_Holiday()
Dim Search As String
Dim Replacement As String
Dim rngTmp As Range
Dim rngSearch As Range
LastInputRow = Range("A65536").End(xlUp).Row
Set rngSearch = Worksheets("Holiday").Range(Cells(2, 1), Cells(98, 2))
For k = 2 to 98
Search = Worksheets("Holiday").Cells(k, 8)
Replacement = Worksheets("Holiday").Cells(k, 9)
With rngSearch
Set rngTmp = .Find(Search, LookIn:=xlValues)
If rngTmp Is Nothing Then
GoTo Go_to_next_input_row:
Else
Worksheets("Holiday").Cells(rngTmp.Row, rngTmp.Column + 1).Value = Replacement
End If
End With
Go_to_next_input_row:
Next K
End Sub
If I understand your question correctly: for each Cell in H2:H98, you're looking for a match in A2:A98. It won't necessarily be on the same row. If you find a match in Column A, you want to take the value from Column B and put it in Column I on the same row as the search value we just looked for. In this case, this code will work:
Option Explicit
Sub Test()
Dim ws As Worksheet
Dim srcRng As Range '' Source range
Dim schRng As Range '' Search range
Dim c As Range
Dim search As Range
Set ws = ThisWorkbook.Sheets(1)
Set srcRng = ws.Range("H2:H98")
Set schRng = ws.Range("A2:A98")
For Each c In srcRng '' Iterate through your source range
Set search = schRng.Find(c.Value, LookIn:=xlValues, SearchDirection:=xlNext) '' Find the value from column H in column A
If Not search Is Nothing Then
c.Offset(, 1).Copy search.Offset(, 1) '' Get the value from column B, from the same row as the value it found in column A
'' Then paste that value in column I, on the same row as the value we searched for from column H
End If
Next c
GoTo statements are generally (generally, not always) very, very bad practice. Especially in this kind of situation. You don't need them, it just makes your code convoluted.