Here are your reports produced by pivot tables
HTH,
--
AP
Posts by ArdusPetus
-
-
-
Hi,
Could you please post as an attachment the document Test.docx which contains bookmarks.
TIA,
--
AP
-
Hi,
Code- Sub CopyBUO()
- Dim rngSource As Range, rngDest As Range
- Worksheets("Budget Use Only").Activate
- Set rngSource = [A1].CurrentRegion.Resize([a:a].Find("", , xlValues, xlWhole, xlByColumns).Row - 1)
- Set rngDest = Worksheets("Upload - Budget Use Only").[A1].Resize(rngSource.Rows.Count, rngSource.Columns.Count)
- rngDest.Value = rngSource.Value
- rngDest.Worksheet.Activate
- End Sub
Budget Adjustment Template (VBA) v1.0.xlsm
HTH
--
AP
-
-
The output fields were blank because there is nothing to replace in the input field.
I modified the macro so that, in case no keyword was found in input, it prints input without changes in output field.
-
Could you please post a workbook with sample expected results ?
TIA
--
AP
-
Display MoreCode
- Option Explicit
- Sub Replace()
- Dim wOR As Worksheet, wRR As Worksheet
- Dim rngIn As Range
- Dim tabRepl As Variant
- Dim i As Long
- Set wOR = Worksheets("Original Range")
- Set wRR = Worksheets("Replace Range")
- tabRepl = wRR.[A1].CurrentRegion
- For Each rngIn In Range(wOR.[A2], wOR.Cells(Rows.Count, "A").End(xlUp))
- For i = LBound(tabRepl) To UBound(tabRepl)
- If InStr(1, rngIn, tabRepl(i, 1)) > 0 Then
- wOR.Cells(rngIn.Row, "C") = tabRepl(i, 1)
- wOR.Cells(rngIn.Row, "E") = tabRepl(i, 2)
- wOR.Cells(rngIn.Row, "G") = Strings.Replace(rngIn, tabRepl(i, 1), tabRepl(i, 2))
- Exit For
- End If
- Next i
- Next rngIn
- End Sub
- [attach=1227660][/attach]
- HTH,
- --
- AP
-
You posted a .xlsx workbook without any code. Please post the original .xlsm.
Cheers,
--
AP
-
Could you please fill Sheet4 Output with the desired results.
-
Could you please attach a sample workbook ?
-
Paste this in your worksheet code,
then save the workbook as xlsm.
-
Display MoreCode
- Option Explicit
- Sub LoopPDFsInFolder()
- Dim wb As Workbook
- Dim myPath As String
- Dim myFile As String
- Dim myExtension As String
- Dim r As Long
- Dim WApp As Object
- Dim WDoc As Object
- Dim WDR As Object
- Dim ExR As Range
- ' Application.ScreenUpdating = False
- Application.EnableEvents = False
- Application.Calculation = xlCalculationManual
- myPath = "c:\users\laurent\documents\perso\"
- myExtension = "*.PDF*"
- myFile = Dir(myPath & myExtension)
- Set WApp = CreateObject("Word.Application")
- WApp.Visible = True
- r = 0
- On Error GoTo ResetSettings
- Do While myFile <> "" 'Loop through each Excel file in folder
- Set ExR = Selection ' current location in Excel Sheet
- Set WDoc = WApp.Documents.Open(myPath & myFile)
- WApp.Selection.HomeKey Unit:=6
- WApp.Selection.Find.ClearFormatting
- WApp.Selection.Find.Execute "In the matter of the" 'find key phrase
- WApp.Selection.MoveDown Unit:=5, Count:=1
- WApp.Selection.HomeKey
- WApp.Selection.MoveRight Unit:=3, Count:=1, Extend:=1
- Set WDR = WApp.Selection ' copy selected sentence to excel
- ExR(1, 1).Offset(r, 0) = WDR ' place below selected cell
- r = r + 1
- WDoc.Close
- myFile = Dir 'Get next file name
- Loop
- ResetSettings:
- WApp.Quit
- Set WApp = Nothing
- Set WDoc = Nothing
- Set WDR = Nothing
- Application.EnableEvents = True
- Application.Calculation = xlCalculationAutomatic
- Application.ScreenUpdating = True
- MsgBox "Done!"
- End Sub
This should work faster
Cheers,
--
LR