0
votes

I want to add something to my VBA code so I can search for the text from Worksheet named "Pull", cell "A2" in a Worksheet named "HourTracker" in column "A" and offset 1 cell to the right. In this cell that I find, I want to paste in the contents of cell "Z1" in the "Pull" worksheet.

Each time I run the macro, the contents of "Pull" changes and so does cell "A2" and "Z1". "A2" will contain the word I can find in column A of the "HourTracker" sheet, and "Z1" from the "Pull" sheet will have the total hours that needs to go in the cell next to the found cell in "HourTracker".

Sub Function_DataSpecial()

Application.DisplayAlerts = False

Worksheets("Pull").Activate
    Columns("A:BB").Select
    Selection.ClearContents
With ActiveSheet.QueryTables.Add(Connection:="URL;" & 
Sheets("Control").Range("B9").Value, Destination:=Range("A1"))
.Name = "Pull"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

Range("A:A").Select
  Selection.TextToColumns _
  Destination:=Range("A1"), _
  DataType:=xlDelimited, _
  TextQualifier:=xlDoubleQuote, _
  ConsecutiveDelimiter:=False, _
  Tab:=False, _
  Semicolon:=False, _
  Comma:=True, _
  Space:=False, _
  Other:=False

ActiveSheet.Range("A:R").RemoveDuplicates Columns:=Array(2, 5), Header:=xlYes

Range("Z1").Select
ActiveCell.FormulaR1C1 = "=SUM(C[-15])"

Everything down to the ActiveSheet.Range("A:R") part is pulling the table from a website, and sorting the table and below that I am summing up the Hours column and putting the sum in "Z1". The "A" column in the "HourTracker" worksheet will not change.

I am new to the website so please let me know what other information you all might need to help, thank you!!!

1

1 Answers

0
votes

So after some searching I added the following to my macro, and it works perfectly.

Range("Z1").Select
ActiveCell.FormulaR1C1 = "=SUM(C[-15])"
Range("Y1").Select
ActiveCell.FormulaR1C1 = "=R[1]C[-24]"

Range("Z1").Copy

Dim FindString As String
Dim Rng As Range
FindString = Sheets("Pull").Range("Y1").Value
If Trim(FindString) <> "" Then
    With Sheets("HourTracker").Range("A:A")
        Set Rng = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Not Rng Is Nothing Then
            Application.Goto Rng, True
        Else
            MsgBox "Nothing found"
        End If
    End With
            ActiveCell.Offset(0, 1).Activate
            Selection.PasteSpecial xlPasteValues

I had cell "Y1"=A2, copied the hours (Z1) and then used the FindString to search for the last value of cell "Y1" on "Pull" sheet. Once I do that, I used the active cell offset to select the cell to the right of it and pasted the value.

I hope that this helps anyone else trying to do something similar to me!!