Autofill One Cell VBA Excel - vba

I am trying to autofill an equation only one column to the right of the active row and am having trouble. For example, there is an equation in I5, I want to have a macro that will auto fill J5 and only J5.
Thanks,
Becca

My deduction from your limited data is that you need the below solution. (Please do reply with details if you need more functionality than this.)
Public Sub FormulaPopulation()
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Sheet1.Range("J2") ' Have assumed over here that the formula that you need autofilled is in "J2" which is an unrelated cell
Set rng2 = Sheet1.Range("J5") ' Then since you only need this cell filled we take this cell.
rng2.Formula = rng1.Formula ' Finally it is formula matched, rather than Autofilling. Much faster than autofill.
End Sub

Related

Excel Database data issue

I have a farily large database of around 2000 people, sheet1 has all of their names and relevant details. Sheet 2 has data pulled on from a site. I would like the data from sheet 2 to auto populate the cells in Sheet 1. Also if the person does not exist in sheet1 to highlight the data it couldnt do. I am so stuck on this.
Sub dup()
Dim cell As Range, cella As Range, rng As Range, srng As Range
Set rng2 = Sheets(2).Range("A2:E2000")
Set rng3 = Sheets(3).Range("A2:E29000")
For Each cell In rng2
For Each cella In rng3
If cella = cell Then
cella.Interior.ColorIndex = 6
' cella.AddComment.Text Text:="duplicate value"
End If
Next cella
Next cell
Set rng2 = Sheets(2).Range("T2:Y2000")
Set rng4 = Sheets(4).Range("A1:F2000")
For Each cell In rng2
For Each cella In rng4
If cella = cell Then
cella.Interior.ColorIndex = 6
' cella.AddComment.Text Text:="duplicate value"
End If
Next cella
Next cell
End Sub
Its hard for me to show as it has a lot of columns not sure how on earth i can show you what im trying to do? :(
Try https://filetea.me/t1sfGPWECvdQqmgVDGtXL4oRQ
Maybe, if you want to do it without vba, you could use the LOOKUP function in the sheet 1's auto populate column. It works like that:
=LOOKUP(sheet1!A2, sheet2!table[a], sheet2!table[b])
This will find the value in the column "b" of the table in sheet2 based on the values of column "a". This will chose the value in the same row were column "a" matches the value in sheet1's A column. Let me know if I wasn't clear enough here.
Then you can use Conditional Formatting rules for the highlight you said. I suggest the COUNTIF function, that will return 0 if no matching value is found in the specified range.
=COUNTIF(A2:A5,A4)
This, for example, cont values in A2:A5 that matches the values in A4.
Also, you will find the conditional formatting tools in the home tab, if you are using excel 2016.
See the link for more information:
Information you may need

VBA Copying cells to another worksheet where cells have the same value

I have two worksheets I'm working with with long serial numbers as the cell values. One sheet (Sheet1) has a list of each individual serial number hyperlinked to a webpage referring to that item. This list ranges from A1:A31.
The second sheet (Sheet2) has a massive list of those same serial numbers, but in range G1:G102. The difference is that this list is not hyperlinked, and the serial numbers sometimes show up multiple times. There are also some areas where a cell is blank, so it splits up the continuous column of data.
I would essentially like to write a macro that takes the first list in Sheet1, and for each cell, it compares it to each cell in Sheet2 column G. Then, if the values match, I would like to copy the hyperlinked cell from Sheet 1 and paste it to that cell with the same value in Sheet2. Therefore, Sheet2 column G now has a fully populated list of hyperlinked serial numbers.
Can anyone help me with this? This is what I have so far...doesn't seem to work:
Sub CopyHyperlinks()
Dim cell As Excel.Range
Dim myRange As Excel.Range
Dim newRange As Excel.Range
Set myRange = Excel.ThisWorkbook.Sheets("Contents").Range("A1:A31")
Set newRange = Excel.ThisWorkbook.Sheets("Sheet1").Range("G1:G102")
For Each cell In myRange
If myRange.Cells.Value = newRange.Cells.Value Then newRange.Cells.Value = myRange.Cells.Value
Next cell
End Sub'
See this little function. Put this:
Function GetHyperLinkAddress(rng As Range) As String
Dim hl As Hyperlink
For Each hl In rng.Parent.Hyperlinks
If hl.Range.Address = rng.Address Then
GetHyperLinkAddress = hl.Address
Exit Function
End If
Next hl
GetHyperLinkAddress = "Not Found"
End Function
in a module. In the Spreadsheet, add
=GetHyperLinkAddress(Cell#)
Next to the cells with the hyperlink. You could then just use a vlookup to match.

IF THEN VBA MACRO - Update one column if contents of another = 100%

I have a workbook with "Results" being sheet 3, this being the worksheet I want to use.
I have tried a few formulaes to try and add a macro to do the following:
I have column G with percentages. I then have column I where I would like there to be a result saying TRUE/FALSE where the contents of G are equal to 100%. Column G is formatted to percentage with two decimals.
Some considerations: I have my first row being a Hyperlink to another sheet, then my headings, then the first row of "results". I have 457 rows, if there is a measurement of the range, perhaps it could be on A?
I keep getting this error 9 with my range and have got a bit stuck.
Thanks in advance!
Sub PartialHits1()
Dim rng As Range
Dim lastRow As Long
Dim cell As Range
With Sheet3
lastRow = .Range("G" & .Rows.Count).End(xlUp).Row
Set rng = .Range("G1:G" & lastRow)
For Each cell In rng
If cell.Value = 100
Then
cell.Range("I1:I1").Value = 100
End If
Next
End With
End Sub
(I have hacked this a bit, just was trying to get it to set as 100 instead of the TRUE/FALSE Also was playing around near the Sheet 3 part as I got errors.)
RangeVariable.Range can refer only to a cell within RangeVariable, so you can't refer to column I in this way. Try: .Range("I"&cell.row)=100.
Also your criteria is probably wrong, if you have 100% in a cell it's actual value is 1.
And last question: why do you want to do this with VBA, it would be much more simple with worksheet function =IF(G3=1,100,"")

Excel VBA value remains string format after replacment

I am a total newbie in Excel VBA. I find a script that can help me map data from one worksheet to another, but after the mapping is done, the value format just changed.
I have two sheets, Sheet 1 is the raw data sheet, and Master Data sheet is where the mapping data are stored. Please see the table structures below:
Sheet 1:
Description:
Home Use
Business Owner
Professional
CFO
Secretary
Master Data sheet:
code Description
001 Home Use
002 Business Owner
003 Professional
004 CFO
005 Secretary
As you may see the values in the first column in the Master Data sheet are in text format, ie 001, 002, etc
The code below does the trick to map the data in the first column in Master Data sheet and use them to replace the description in Sheet 1.
Sub mapping()
Dim rng1 As Range, rng2 As Range, cel As Range
Dim StrMyChar As String, StrMyReplace As String
With ActiveWorkbook.Worksheets("Master Data")
Set rng1 = .[B1:B5]
End With
With ActiveWorkbook.Worksheets("Sheet1")
Set rng2 = .[A2:A6]
End With
'loop down list of texts needing replacing
For Each cel In rng1.Cells
StrMyChar = cel.Value
StrMyReplace = cel.Offset(0, -1).Value
'replace text
With rng2
.Replace What:=StrMyChar, Replacement:=StrMyReplace,_
SearchOrder:=xlByColumns, MatchCase:=False
End With
'Next word/text to replace
Next cel
End Sub
After running the code, I find all the 001, 002, etc all got changed to 1, 2, etc.
Is there a way for me to preserve the 001 string format?
Thanks.
Try this below. Note that it still forces the replacement format, so that the values in the cells are still technically numbers. This is a drawback of Excel's replace functionality--its just how it works because it wants to assume that everything is numeric.
Note that you also had the rng1 set to the wrong range, it should be b2-b6 not b1-b5
With ActiveWorkbook.Worksheets("Master Data")
Set rng1 = .[B2:B6] ' Note that you had the wrong range here
End With
'this will force two leading zeros if necessary call it before the replace
Application.ReplaceFormat.NumberFormat = "00#"
'then add ReplaceFormat:=true to your replace string
.Replace What:=StrMyChar, Replacement:=StrMyReplace, _
SearchOrder:=xlByColumns, MatchCase:=False, ReplaceFormat:=True
Unfortunately ReplaceFormat.NumberFormat = "#" does not work with Excel's built in replace. The better option if we don't want to mess with Excel's built in replace method, we can do it ourselves, quick and easy:
Option Compare Text 'use this for case insensitive comparisons
Sub Mapping()
Dim rngLookup As Range
Set rngLookup = ActiveWorkbook.Worksheets("Master Data").[B2:B6]
Dim rngReplace As Range
Set rngReplace = ActiveWorkbook.Worksheets("Sheet1").[A2:A6]
Dim cell As Range, cellLookup As Range
For Each cell In rngReplace
Dim val As String
val = cell.Value
For Each cellLookup In rngLookup
If cellLookup.Value = val Then
cell.NumberFormat = "#"
cell.Value = cellLookup.Offset(0, -1).Value
Exit For
End If
Next
Next
End Sub
This code loops through each line in your Sheet 1, and then searches for the proper entry in the master sheet, but sets the Number Format to "#" before it copies it. You should be good.
If you are going to have to work with a LOT of cells, consider turning Application.ScreenUpdating off before running the procedure, and back on after. This will speed things up as it doesn't have to worry about rendering to the screen while it is working.
Another, non VBA idea that keeps both the original value and adds data next to it:
You could also get this information (albeit in a different column) using a Vlookup without any VBA code. If you switch your Descriptions to Column A and your Codes to Column B on the Master Sheet, you can then go to Sheet1, highlight the cells in Column B and type this formula:
=VLOOKUP(A2:A6,'Master Data'!A2:B6,2,FALSE)
Do not hit enter, but rather hit Control+Shift+Enter. This creates what is called an Array formula. This doesn't do a replace for you, but offers the data in the column next to it. Just throwing this out there as some extra information if you needed another way of getting it.
You could also set the formula for a cell in VBA using the Range.Formula property and setting it to the vlookup formula above

How to loop a dynamic range and copy select information within that range to another sheet

I have already created a VBA script that is about 160 lines long, which produces the report that you see below.
Without using cell references (because the date ranges will change each time I run this) I now need to take the users ID, name, total hours, total break, overtime 1, and overtime 2 and copy this data into sheet 2.
Any suggestions as to how I can structure a VBA script to search row B until a blank is found, when a blank is found, copy the values from column J, K, L, M on that row, and on the row above copy value C - now paste these values on sheet 2. - Continue this process until you find two consecutive blanks or the end of the data...
Even if you can suggest a different way to tackle this problem than the logic I have assumed above it would be greatly appreciated. I can share the whole code if you are interested and show you the data I began with.
Thank you in advance,
J
As discussed, here's my approach. All the details are in the code's comments so make sure you read them.
Sub GetUserNameTotals()
Dim ShTarget As Worksheet: Set ShTarget = ThisWorkbook.Sheets("Sheet1")
Dim ShPaste As Worksheet: Set ShPaste = ThisWorkbook.Sheets("Sheet2")
Dim RngTarget As Range: Set RngTarget = ShTarget.UsedRange
Dim RngTargetVisible As Range, CellRef As Range, ColRef As Range, RngNames As Range
Dim ColIDIndex As Long: ColIDIndex = Application.Match("ID", RngTarget.Rows(1), 0)
Dim LRow As Long: LRow = RngTarget.SpecialCells(xlCellTypeLastCell).Row
'Turn off AutoFilter to avoid errors.
ShTarget.AutoFilterMode = False
'Logic: Apply filter on the UserName column, selecting blanks. We then get two essential ranges.
'RngTargetVisible is the visible range of stats. ColRef is the visible first column of stats.
With RngTarget
.AutoFilter Field:=ColIDIndex, Criteria1:="=", Operator:=xlFilterValues, VisibleDropDown:=True
Set RngTargetVisible = .Range("J2:M" & LRow).SpecialCells(xlCellTypeVisible)
Set ColRef = .Range("J2:J" & LRow).SpecialCells(xlCellTypeVisible)
End With
'Logic: For each cell in the first column of stats, let's get its offset one cell above
'and 7 cells to the left. This method is not necessary. Simply assigning ColRef to Column C's
'visible cells and changing below to CellRef.Offset(-1,0) is alright. I chose this way so it's
'easier to visualize the approach. RngNames is a consolidation of the cells with ranges, which we'll
'copy first before the stats.
For Each CellRef In ColRef
If RngNames Is Nothing Then
Set RngNames = CellRef.Offset(-1, -7)
Else
Set RngNames = Union(RngNames, CellRef.Offset(-1, -7))
End If
Next CellRef
'Copy the names first, then RngTargetVisible, which are the total stats. Copying headers is up
'to you. Of course, modify as necessary.
RngNames.Copy ShPaste.Range("A1")
RngTargetVisible.Copy ShPaste.Range("B1")
End Sub
Screenshots:
Set-up:
Result:
Demo video here:
Using Filters and Visible Cells
Let us know if this helps.