I would like to ask for the help with one simple macro. It does the job for my team mates to compare the data and apply countif function and bring the proper data. However, macro has the autofill set up to D108. I would like to change it slightly to autofill it until last populated row. Could anyone help me to amend it to work as it should?
Sub Countif_function()
Sheets("Account Campaign Member").Select
Range("D1").Select
ActiveCell.FormulaR1C1 = "How Many Contacts do we have?"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=COUNTIF('Campaign Member'!C[-2],RC[-1])"
Selection.AutoFill Destination:=Range("D2:D108")
Range("D2:D108").Select
Columns("D:D").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("B:D").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Comparison").Select
Range("A1").Select
ActiveSheet.Paste
Columns("A:B").EntireColumn.AutoFit
Columns("A:B").EntireColumn.AutoFit
Columns("B:B").Select
End Sub
Try this update
Sub Countif_function()
Sheets("Account Campaign Member").Range("D1")= "How Many Contacts do we have?"
with Sheets("Account Campaign Member").Range("D2:D" & .cells(rows.count,3).end(xlup).row)
.FormulaR1C1 = "=COUNTIF('Campaign Member'!C[-2],RC[-1])"
.value=.value
end With
Sheets("Account Campaign Member").Columns("B:D").copy Sheets("Comparison").Range("A1")
Sheets("Comparison").Columns("A:B").EntireColumn.AutoFit
Sheets("Comparison").Columns("B:B").Select
End Sub
use this code
LastRow = Range("A2").End(xlDown).Row
Range("D2").AutoFill Destination:=Range(Range("D2"), Range("D" & LastRow))
instead of
Selection.AutoFill Destination:=Range("D2:D108")
Related
Good day all
I want to use VBA to avoid the slowness in Excel when moving from one sheet to another. I replace formulas with VBA code. In brief I want to filter a column (A) that has hundreds of words based on the last characters and then use vba code to textjoin them and paste them in one cell. I managed by VBA code to filter them and paste them in another sheet but I want to edit the code to filter the list, textjoin them and paste them to a cell without using formulas. This is the code I used.
Thank you
`
Sub FilteringByLastCharacter()
Dim FLCretera As String
FLCretera = ThisWorkbook.Worksheets("Searching").Range("A2")
Sheets("WordsList").Select
Range("A1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$B12169").AutoFilter Field:=1, Criteria1:="*" & FLCretera
Columns("A:A").Select
Selection.Copy
Sheets("Searching").Select
Range("S1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("WordsList").Select
ActiveSheet.Range("$A$1:$B$12169").AutoFilter Field:=1
Sheets("Searching").Select
Range("A1").Select
Application.CutCopyMode = False
Range("A2").Select
End Sub`
application.displayalerts=false
application.screenupdating=false
FLCretera = ThisWorkbook.Worksheets("Searching").Range("A2")
Sheets("WordsList").Select
Range("A1").Select
''''clear filters
On error resume next
activesheet.clearallfilters
''''''find the las cells with inf
uf=ActiveSheet.Columns("A").Find("*", _
searchorder:=xlByRows, searchdirection:=xlPrevious).Row
''''create filter
ActiveSheet.Range("$A$1:$B" & uf).AutoFilter Field:=1, Criteria1:="*" & FLCretera
range("A1:B" & uf).copy
'''''
Sheets("Searching").Select
Range("S1").Select
Selection.PasteSpecial Paste:=xlPasteValues
for flag = 1 to uf
'''range("C" & flag) where paste the words for Cells A and B
range("C" & flag)=range("A" & flag)&range("C" & flag)
next flag
Sheets("WordsList").Select
Application.CutCopyMode = False
application.displayalerts=true
application.screenupdating=true
End Sub
sorry, my english is short, but i try to help.
take care
I have a workbook with a column that contains date strings - itself being copied from another source as "paste as values". I need to transform that date number into an abbreviated month - say Jan, Feb, etc.
I tried recording it but the macro doesn't understand autofill for formulas, so if the length of the data changes, more or fewer rows, then it doesn't fill out all the spaces or overfills them.
I tried amending the formula to include whole range with End(xlDown) instead of the fixed range it was giving, but then all the rows down to the very bottom are filled.
Here's the code, but I'm open to any other solution.
Sub ConvertDateStringToMonth()
'
' ConvertDateStringToMonth Macro
'
'
Columns("I:I").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("I2").Select
ActiveCell.FormulaR1C1 = "=TEXT(RC[-1], ""mmm"")"
Range("I2").Select
Selection.AutoFill Destination:=Range([I2], [I2].End(xlDown))
Range([I2], [I2].End(xlDown)).Select
Range("H1").Select
Selection.AutoFill Destination:=Range("H1:I1"), Type:=xlFillDefault
Range("H1:I1").Select
Columns("I:I").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("H:H").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("H1").Select
End Sub
Nevermind, with some googling and common sense I used this and it works:
Sub ChangeDate()
Set DateRange = Range([H2], [H2].End(xlDown))
DateRange.NumberFormat = "mmm"
End Sub
Posting here in case anyone else has such a simple question.
I recorded a macro, linked to a button, on say sheet1. The object of what I need done:
When the button is pressed, certain cells are selected and copied to a "summary" page on another sheet.
Sheet1 has a drop down that shows certain information. So after data is selected from the drop down, the user will push the button and post that data to the summary sheet.
The macro works fine (please note I am a VBA noob), but I need assistance in adding functionality that after every button press, it copies the data on the next line - in other words, if data is in row 1 already, it must place the data in row 2, and so on.
The VB code I have is as follows:
Sub Test()
'
' Test Macro
'
'
Range("C32:N32").Select
Selection.Copy
Sheets("Summary").Select
Range("D3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks
_
:=False, Transpose:=False
Sheets("Comm Payable").Select
Range("C3:D3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Summary").Select
Range("B3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks
_
:=False, Transpose:=False
Sheets("Comm Payable").Select
Range("N1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Summary").Select
Range("C3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks
_
:=False, Transpose:=False
Range("B4").Select
Sheets("Comm Payable").Select
Range("O1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ""
Range("O1").Select
End Sub
Please could someone assist with the addition described above?
Much appreciated!
It's imperative you read the link posted by PEH as you can considerably shorten and speed up your code. I think this does what you want.
Sub Test()
Dim r As Long
r = WorksheetFunction.Max(Sheets("Summary").Range("D" & Rows.Count).End(xlUp).Row + 1, 3)
Sheets("Comm Payable").Range("C32:N32").Copy
Sheets("Summary").Range("D" & r).PasteSpecial Paste:=xlPasteValues
Sheets("Comm Payable").Range("C3:D3").Copy
Sheets("Summary").Range("B" & r).PasteSpecial Paste:=xlPasteValues
Sheets("Comm Payable").Range("N1").Copy
Sheets("Summary").Range("C" & r).PasteSpecial Paste:=xlPasteValues
Sheets("Comm Payable").Range("O1").ClearContents
End Sub
As an aside, transferring values directly is more efficient than copying and pasting and here is an example of that.
With Sheets("Comm Payable").Range("C32:N32")
Sheets("Summary").Range("D" & r).Resize(.Rows.Count, .Columns.Count).Value = Value
End With
I am setting up a attendance spreadsheet where we count the total Late and sick days using the CountIf function. Employees are listed one per column. I am trying to write a macro that will count the number of late or sick days per employee, enter that value to a cell and copy that value to a summary sheet. Then using a For Loop to iterate through each employee using the same range (number of rows) but always moving over one column.
This is my first time really using VBA so I am stuck as my code gives me an error when trying to iterate up the columns.
Thank you!
Sub Counting()
ActiveCell.Select
ActiveCell.Offset(0, -1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(R[-10]C[2]:RC[2],""L"")"
Selection.Copy
Sheets("Sheet3").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1").Select
Application.CutCopyMode = False
Selection.ClearContents
Dim LastCol As Integer
With ActiveSheet
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
Dim i As Integer
For i = 1 To LastCol
ActiveCell.FormulaR1C1 = "=COUNTIF(R[-10]C[i]:RC[i],""L"")"
ActiveCell.Select
Selection.Copy
Sheets("Sheet3").Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Sheets("Sheet1").Select
Application.CutCopyMode = False
Selection.ClearContents
Next i
End Sub
The problem is with this line:
ActiveCell.FormulaR1C1 = "=COUNTIF(R[-10]C[i]:RC[i],""L"")"
It looks like you want the value of i in here, not the letter "i", which you can do like this:
ActiveCell.FormulaR1C1 = "=COUNTIF(R[-10]C[" & i & "]:RC[" & i & "],""L"")"
This will fix your immediate error message, however the macro as whole is very fragile, you should read article PEH referenced and replace all those .Select / .Copy / .PasteSpecial as much as possible.
Alternatively, you can probably do what you need without a macro, and use formulas instead. If you can it would be preferable.
I believe I'm having an issue with either appropriately identifying a fixed cell or order of operations. I've spent an hour an a half researching and can't find the answer. The issue is only with the Concatenation row: I can't get VBA to recognize the insertion of a fixed cell into the text of the formula (I can only get it R the cell). It's for a daily exported excel report from a database that inserts the date into C2. I'm concatenating the file names in column B with the folder location they'll be in at the end of the day, the day's date and the unique file group identifier in each matching cell in column C. I've replaced the text of the folder name with FOLDER for confidentiality purposes. I can concatenate and autofill it manually, but I'd rather just type the formula in once! Any assistance would be helpful.
Thanks! - John
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C2").Select
ActiveCell.FormulaR1C1 = "=TEXT(RC[-1],""yyyy mm dd"")"
Range("C2").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A5").Select
ActiveCell.FormulaR1C1 =
"=CONCATENATE(""FOLDER,("$C$2"), FOLDER"",RC[1])"
Dim lastRow As Long
lastRow = Range("B" & Rows.Count).End(xlUp).Row
Range("A5").Select
Selection.AutoFill Destination:=Range("A5:A" & lastRow), Type:=xlFillDefault
Range("A5:A" & lastRow).Select
Selection.Copy
Range("B5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Rows("1:2").Select
Selection.Delete Shift:=xlUp
Range("B3").Select
I don't know if this will work since the formula is expecting references via the RC notation, but you could try:
ActiveCell.FormulaR1C1 =
"=CONCATENATE(""FOLDER,(" & "$C$2" & "), FOLDER"",RC[1])"
As an alternative to inserting a fixed cell, an option would be to assign that cell's value to a string variable and than insert that.
Dim dateVal as string
dateVal = Range("C2").Value2
Range("A5").FormulaR1C1 =
"=CONCATENATE(""FOLDER,(" & dateVal & "), FOLDER"",RC[1])"