need some help thinking through how to do this.
ultimately, what i want to achieve is to sum together cells based on if another corresponding cell is 0 or 1. it's a bit convoluted but i'll try my best to explain.
sheet 1 has data that shows, by month, if actuals have come in for the month. a column will display a 0 for accounts/month that need to be added.
sheet 2 has two tables. table 1 pulls in the 0 & 1 from sheet 1 and uses conditional formatting to highlight cells that need to be added. the only thing in this table is 0 & 1. table 2 is the exact same setup as table 1, just with the actual numbers.
my original thought was to just copy the highlighting format from table 1 onto table 2 then use a macro to sum highlighted cells. obviously, i have found that that is not possible.
i tried looking around and haven't found anything that lets me just copy the highlighting format without overwriting the numbers in table 2.
is this possible?
Try this. I'm not sure how your data is laid out, but if it's in a row, you can run this on a new cell at the end of that row (meaning, the next empty column):
Function sumHighlighted(ByVal myRng As Range)
Dim cel As Range, iRow As Range
Dim fSum As Long, totalRows As Long
fSum = 0
For Each cel In Range(Cells(myRng.Row, 1), Cells(myRng.Row, myRng.Column))
If cel.Interior.ColorIndex <> -4142 Then
fSum = fSum + cel.Value
End If
Next cel
Debug.Print "The total in this row is: " & fSum
sumHighlighted = fSum
End Function
Steps:
1. Copy the Cell with conditional Format.
2. Paste to cell where you want (Hold ALT + press E + S + T).
To generate a code, click "Record Macro" first and do the 2 steps above and stop the recording macro once you're done.
Related
I have a 7702216772 number inside a cell. If I put a ' before the fist digit and click Enter Excel transforms the number to a text and puts a green triangle at the left top of the cell:
I have many rows of similar numbers all of which need to be transformed into text. However clicking each and adding ' before the first symbol and clicking Enter would take a lot of time. Is there any way to do it programatically?
I tried using formula: ="'"&H4 but it doesn't do what's expected - the green triangle never appears on the result cell.
I also tried setting cell format to Text, but the green triangle doesn't appear in that case too.
I need the green triangle to appear at the upper left corner, just like at the picture!
If all your number are in a single column, the following code will do it:
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your worksheet, amend as required
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
For i = 1 To LastRow 'loop from row 1 to last
ws.Cells(i, "A").Value = "'" & ws.Cells(i, "A").Value 'add the ' before the number
Next i
End Sub
Change the "A" to whichever column you are using.
Just Select the cells you wish to process and run this short macro:
Sub Textify()
Dim rng As Range, r As Range
Set rng = Selection.Cells.SpecialCells(2, 1)
For Each r In rng
r.Value = "'" & r.Value
Next r
End Sub
Non VBA answer; I'm using Column G in this answer but it depends on where your numbers are. You'll have to change the cell but I think you will be ok with this.
In an empty cell, enter formula: ="'"&G4
Use the fill handle or Ctrl+D to fill it down to the length of Column G's values.
Select the whole of Column G's values and copy them to the clipboard
Select the same range in Column G, right-click, select Paste Special and choose Values
I have tested it now for several times and it worked always
Cells(xx, xx).FormulaR1C1 = "'" & Cells(xx, xx).Value
Same would work for ActiveCell or whatever you like.
I have a macro that is generally slow due to overuse of LOOKUP formulas. I want to insert some VBA variables to speed these up. I am currently working on speeding up the formula below:in Excel:
=IF(ISNA(MATCH(A2,Summary!B:B,0)),"n",I2-((I2/LOOKUP(2,1/(I:I<>""),I:I))*VLOOKUP(A2,Summary!$G$10:$H$902,2,FALSE)))
in VBA:
"=IF(ISNA(MATCH(RC[-9],Summary!C[-8],0)),""n"",RC[-1]-((RC[-1]/LOOKUP(2,1/(C[-1]<>""""),C[-1]))*VLOOKUP(RC[-9],Summary!R10C7:R902C8,2,FALSE)))"
The portion I need to replace is LOOKUP(2,1/(C[-1]<>""""),C[-1]). All this does is reference the last non empty cell in column I. Right now I have the following code to return the address of the last cell in VBA
Sub FormulaTest()
Set lRow = Range("I1").SpecialCells(xlCellTypeLastCell).Address
End Sub
I am trying to figure out how to implement this "lRow" into the VBA code for the formula. Can anyone steer me in the right direction?
**EDIT 1
Please see Fernando's comment below. He has the right idea however the solution is still off a bit. Ill try to explain it better in a few comments: First off, The first row is always a title row, the last row is always a sum row, the current tab is the "Sales" tab, and the amount of rows in any given Sales tab will vary (could be I1:I59, could be I:1:I323).
In this example I1 is a row title and I59 is the sum of I2:I58. Rows I2:I58 are dollar amounts. My macro places this formula in J2:J58. This formula takes each row's dollar amount (I2:I58) as a percentage of the total (I59) and multiplies it by an input amount on the Summary tab (the VLOOKUP). This amount is then subtracted proportionately from the dollar value in column I with the J cell showing the result.
I am looking to eliminate the need for the LOOKUP function (selects last non empty cell) within my formula above: LOOKUP(2,1/(C[-1]<>""""),C[-1]).
**EDIT 2
Fernando's solution worked. Thank you all for your input
This would return the last non-empty row in column I
with Worksheets("Summary")
lRow = .Cells(.Rows.Count, "I").End(xlUp).Row
end with
So your code would be
sub testy
dim lRow as long
with Worksheets("Summary")
lRow = .Cells(.Rows.Count, "I").End(xlUp).Row
end with
"=IF(ISNA(MATCH(RC[-9],Summary!C[-8],0)),""n"",RC[-1]-_
((RC[-1]/R"&lRow&"C[-1])*VLOOKUP(RC[-9],Summary!R10C7:R902C8,2,FALSE)))"
In your solution you're using xlCellTypeLastCell. This is very useful, but it calculates based on UsedRange, which may not be what you want. with this, if you have data up to row n and then you update the data and now you have less records, the last row with xlCellTypeLastCell will still be n, so be careful with that.
Assuming that you are doing all your work on the active sheet, looking up to a "Summary" sheet:
Sub fillCol()
Dim aRow As Long, bRow As Long
aRow = Cells(Rows.Count, "I").End(xlUp).Row
bRow = Sheets("Summary").Cells(Rows.Count, "I").End(xlUp).Row
Range("J2:J" & aRow).FormulaR1C1 = "=IF(ISNA(MATCH(RC[-9],Summary!C[-8],0)),""n"",RC[-1]-" _
& "((RC[-1]/" & aRow & ")*VLOOKUP(RC[-9],Summary!R10C7:R" & bRow & "C8,2,FALSE)))"
End Sub
You made need to change the columns which contain the contiguous range (in order to determine the last row)
I have two columns with random times and the times come from two different sources so the columns do not have the same amount of data points. I want to start with the first time in the first column and compare it to each time in the second column. If there is a match in times, I would like to pull relevant data. After a match is found (if there is one) I would like for the code to go to the second cell in the first column and compare it to every value in the second column and so on.
Here is the code I have so far:
Sub TransferInfo()
'Activate the Sub to Convert and Format Dates
Call ConvertDates
'Define Variables
Dim st As Worksheet
Dim ts As Worksheet
Dim lastrow As Long
Dim i As Integer
j = 2
'Find and set the last used row
Set st = ThisWorkbook.Worksheets("Data Table")
lastrow = st.Cells(st.Rows.Count, "B").End(xlUp).Row
Set ts = ThisWorkbook.Worksheets("ShopFloor")
'Cycle through/compare Row J, Column 18 based on each cell in Row I, Column 14
For i = 2 To lastrow
Do Until IsEmpty(ts.Cells(j, 8)) Or IsEmpty(st.Cells(j, 2))
If st.Cells(i, 14).Value = ts.Cells(j, 18).Value Then
st.Cells(i, 15).Value = ts.Cells(j, 2).Value
Exit Do
Else
st.Cells(i, 15).Value = ""
End If
j = j + 1
Loop
j = 2
Next i
End Sub
The other sub that I call at the beginning of this sub simply rounds the times in each column to the nearest 15 minute interval to increase the likelihood of matches between the columns.
My question is: The code does not copy and paste any more information although there are times that match between the two columns. Why would the code that I have not work? Also, with larger data sets I am afraid that this the code may crash Excel and because I have a loop within a loop trying to process a lot of data a lot of times, but I don't know of a more efficient way to accomplish what I am trying to without this code.
If anyone has any insights as to why this code doesn't work I would greatly appreciate any help.
Thanks!
Based on your code, it looks like you just need an INDEX/MATCH formula. Use this in O2 and copy down:
=IFERROR(INDEX(B:B,MATCH(N2,R:R,0)),"")
No need for VBA
I'm completely new to VBA and Excel macros in general so I'll try to explain my predicament as clearly as possible. Basically I've got two workbooks, the source workbook which contains a single worksheet with nearly thousands of rows and columns and another workbook with 90+ worksheets, each with two tables that references cells from the source workbook (the tables cover monthly data for the last four fiscal years).
I've shoe-stringed together an automation macro that mostly works, but my primary concern is that it could be done better, specifically I've got one section of code:
'October
cellVarO = ActiveSheet.Range("B8").Formula
cellVarO = Right(cellVarO, 5)
Range("B8").Select
ActiveCell.Formula = "=OFFSET('C:\external\[reference_sheet.xls]Mnthly Rdgs'!" & cellVarO & ",0," & fyNum * 12 & ")"
One thing to note is that this code repeats 24 times, one for each month, and another iteration to use MID so that I'm still selecting the right cell value from the active cell formula (after changing the original formula to include OFFSET). I find this bulky and unnecessary but it's the only way I can wrap my mind around the problem. Another issue, it considers that the cell reference will always be 5 characters long. There are instances where this is not the case.
But basically my months are laid out by column and my years are laid out by row, what I was aiming to do here was look in the cell formula for the cell reference, select the cell value, then use OFFSET to shift the value 12 columns to the most recent one, and print the new value to the most recent year. Suppose if I have the cell formula:
='C:\external\[reference_sheet.xls]Mnthly Rdgs'!QR938
My goal is to take the cell value here (QR938) and shift it right 12 columns. Is there any way to pick out the cell value (other than using MID/RIGHT) and assign it to a variable to offset? Is there a better way to shift the cell value 12 columns other than using OFFSET? Finally, is there any way to perform that same operation across multiple similarly formatted worksheets?
See if this helps
For testing the main code:
Sub Tester()
'offset 12 cols to right
OffsetFormulaReference ActiveSheet.Range("B8"), 0, 12
'offset 12 cols to left
OffsetFormulaReference ActiveSheet.Range("B9"), 0, -12
'offset 12 rows down
OffsetFormulaReference ActiveSheet.Range("B10"), 12, 0
'offset 12 rows up
OffsetFormulaReference ActiveSheet.Range("B11"), -12, 0
'EDIT: loop over sheets and edit a specific range
Dim c As Range, sht as WorkSheet
For Each sht in ThisWorkbook.Sheets
For each c in sht.Range("B8:B20").Cells
OffsetFormulaReference c, 12, 0
Next c
Next sht
End Sub
Utility method for taking the formula from a cell with an external reference and moving it over by the specified number of rows/columns:
Sub OffsetFormulaReference(c As Range, offsetRows, offsetCols)
Dim origForm As String, origAddr As String
Dim arr, rng As Range, newAddr As String
If c.HasFormula Then
origForm = c.Formula
'(e.g.) ='C:\external\[reference_sheet.xls]Mnthly Rdgs'!QR938
If InStr(origForm, "!") > 0 Then
arr = Split(origForm, "!") 'arr(1) = "QR938"
Set rng = ActiveSheet.Range(arr(1)) 'get a range reference
Set rng = rng.Offset(offsetRows, offsetCols) 'move the reference
newAddr = rng.Address(False, False) 'get the offset address
'replace old formula with new offset reference
c.Formula = arr(0) & "!" & newAddr
End If
End If
End Sub
Note: you'll get an error if you try to use Offset() to move the rng reference beyond the limits of the sheet (eg. row or column < 1). You can add logic to handle that if it might be an issue.
I have vba question I have been trying to find the answer for for a long time. I have numerous spreadsheets from numerous clients that I run macro's on, I'm new to coding and have been able to mostly figure out what I need to do. My clients send us data monthly and every month the number of rows change. The columns don't change but the amount of data does. My previous macro's I have just chosen the entire column to copy and paste onto our companies template. This worked fine for must things but has created some really long code and macros take a long time. I would like to write a code that counts how many rows are in a certain column and then from there copies and pastes that however many rows it counted in each column. Only a few columns contain data in every row, so I need it to count the rows in one specific column and apply to that every column. Any help would be appreciated.
Thanks
Tony
Hi Guys,
Still having issues with this, below I pasted the code I'm using if anyone can see why it won't run please help.
Windows("mmuworking2.xlsx").Activate
Workbooks.Open Filename:= _
"C:\Users\I53014\Desktop\QC DOCS\Sample_Data_Import_Template.xlsx"
Windows("mmuworking2.xlsx").Activate
Dim COL As Integer
COL = Range("A:DB").Columns.Select
**Range(Cells(2, COL), Cells(Range("E" & Rows.Count).End(xlUp).Row, COL)).Copy Destination:=Windows("Sample_Data_Import_Template.xlsx").Range("A2")**
Range("A2").Paste
Range("A5000").Formula = "='C:\Users\I53014\Desktop\[Import_Creator.xlsm]sheet1'!$B$2"
ActiveWorkbook.SaveAs Filename:="Range (A5000)", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
I bolded where it keeps stopping.
This should give you the last row containing data:
ActiveSheet.UsedRange.Rows.Count
This will give you the last row in a specific column:
Range("B" & Rows.Count).End(xlUp).Row
here is an example of how I can copy every row in the first three columns of a worksheet
Sub Example()
Dim LastRow As Long
LastRow = ActiveSheet.UsedRange.Rows.Count
Range(Cells(1, 1), Cells(LastRow, 3)).Copy Destination:=Sheet2.Range("A1")
End Sub
You have to be careful as there are some caveats to both methods.
ActiveSheet.UsedRange may include cells that do not have any data if the cells were not cleaned up properly.
Range("A" & Rows.Count).End(xlUp).Row will only return the number of rows in the specified column.
Rows(Rows.Count).End(xlUp).Row will only return the number of rows in the first column.
Edit Added an example
Edit2 Changed the example to be a bit more clear
For this example lets say we have this data
You could copy any other column down to the number of rows in column A using this method:
Sub Example()
Dim Col as Integer
Col = Columns("C:C").Column
'This would copy all data from C1 to C5
'Cells(1, Col) = Cell C1, because C1 is row 1 column 3
Range(Cells(1, Col), Cells(Range("A" & Rows.Count).End(xlUp).Row, Col)).Copy Destination:=Sheet2.Range("A1")
End Sub
The end result would be this: