Posts by Six_of_Ten

Hello all,

I was wondering if someone could help with the last piece of the puzzle. With numerous guides and code snippets I've managed to get the below partially working, however, what I would like is for the resulting data to be pulled in to Excel. I know it is possible, but cannot figure out how to do it.

The code below does everything the way I want, however I cannot pull the resulting data back in to Excel after "get element by ID convert" has run.

For info, column A (any column really, doesn't matter) contains a list of UK postal codes (example data below):

RH13 6EW
BT14 7LN
SA31 1TP

Can anyone help? Where it pastes the data to is irrelevant at the moment. Any help greatly appreciated.

Sub PasteScrapeVERYWIP()
'This is working ok, but CANNOT workout how to extract data back to Excel...............

Dim IE As InternetExplorer
Dim htmlDoc As HTMLDocument
Dim el As HTMLFormElement
Dim pasteValues As String
Dim Vals As Range
Dim R As Long
Dim C As Long
'Dim clipboard As Object

'## Store the values
Set Vals = Range("A1:A50")
For R = 1 To Vals.Rows.Count
    For C = 1 To Vals.Columns.Count
        If Not C = 1 Then
            pasteValues = pasteValues & vbTab & Vals(R, C)
        Else:
            pasteValues = pasteValues & vbNewLine & Vals(R, C)
        End If

    Next
Next

'## Open IE
Set IE = New InternetExplorer
IE.Visible = True
IE.navigate "https://gridreferencefinder.com/postcodeBatchConverter/"
Do Until IE.readyState = 4
    DoEvents
Loop

Set htmlDoc = IE.document
Set el = htmlDoc.getElementById("inputData")
el.innerText = pasteValues

'## convert and select data
htmlDoc.getElementById("convert").Click
'htmlDoc.getElementById("outputData").Copy
'htmlDoc.getElementById("outputData").Select

Set IE = Nothing

End Sub

Having had a play around, I've discovered it was possibly an update by Google which caused it. Trying this new hyperlink has got it working once again.

=HYPERLINK("http://maps.google.co.uk/maps/place/"& L5 & "," & N5, "Click Here")

Ah, that might be it. This may be a problem...

Hello all,

Is anyone aware of any changes to the way Google Map links work within Excel? I have a large spreadsheet setup which uses various mapping sites to help identify key information. Yesterday, a hyperlink to Google Maps become non functional, while other links (Open Street Map, Street Map, Grid Refernce) are still working fine. Please see the attached image showing the error message, as well as hyperlink formula.

Is this an issue within Excel or have Google changed the way their maps work? Searching online has revealed that there are either Internet Explorer (work offline, no longer present in IE11), or registry issues, however, as some hyperlinks are working and not others, I don't believe this to be the issue. Firefox is the default browser.

[ATTACH=JSON]{"data-align":"center","data-size":"full","title":"screenshot_02.png","data-attachmentid":1220275}[/ATTACH]

Thank you very much, worked a treat. I suspected it would be simple.

Hello all,

Courtesty of this forum, I began to use the following code to help me output approximately 30 worksheets, to seperate workbooks. Frequently, some of those workseets contain no data from row A2 and down. I was wondering how could I stop the macros from generating, what are essentially blank workbooks? Row A1 will always have a header row, hence why it would need to identify that row A2 is blank.

This Macro is called from another which runs through a long list of data, copies relevant rows to indiviual workbooks depending on the cell contents, then, eventually outputs that worksheet to a seperate workbook, which is then emailed out to be actioned. Currently I need to manually check for those which are blank and delete them before running an email macro to send them out.

Sub SplitWorkbook()
'Updateby20140612
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim xWs As Worksheet
Dim xWb As Workbook
Dim FolderName As String
Application.ScreenUpdating = False
Set xWb = Application.ThisWorkbook
DateString = Format(Now, "dd mm yyyy")
'FolderName = xWb.Path & "\" & xWb.Name & " " & DateString
FolderName = xWb.Path & "\" & "TBC Chased" & " " & DateString
MkDir FolderName
For Each xWs In xWb.Worksheets
    xWs.Copy
    If Val(Application.Version) < 12 Then
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        Select Case xWb.FileFormat
            Case 51:
                FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If Application.ActiveWorkbook.HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56:
                FileExtStr = ".xls": FileFormatNum = 56
            Case Else:
                FileExtStr = ".xlsb": FileFormatNum = 50
        End Select
    End If
    xFile = FolderName & "\" & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr
    Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum
    Application.ActiveWorkbook.Close False
Next
MsgBox "Files created. You can now open and run the Email Spreadsheet." '& FolderName
Application.ScreenUpdating = True
End Sub

Hello all,

I'm currently getting very frustrated with what I expect will be a very simple issue to resolve. Would someone please look at the code below and offer any advice?

I have a group of macros set up to run through a source workbook, split in to 27 seperate sheets, format each one, then export to a master copy. Everything works fine and it does what I want, however, I'm having difficulty in exiting the code when a specific condition is met. Each created worksheet will have a specific name taken from a cell in the sheet, however, the macro will simply not end when it gets to the final worksheet, it comes up with a run time error. It's not a huge issue as everything runs fine, I just want the error message to not show up. The code for the "broken" section is below.

The issue I have is towards the end with ActiveSheet.Next.Activate. It runs perfectly well, however, when it gets to the final sheet, it won't stop. I've tried naming the final sheet to get it to stop then, no joy. I found and modified the sub Test1() and still no joy, tried naming the last sheet again and exiting, ending, killing, I can't work this out..

All I want it to do is run through each worksheet, export it to the template file, save close and move on to the next one until there are no more sheets. I suspect this is incredibly easy to do, I can't figure it out.

Sub Export()


Dim wbTarget As Workbook 'Template File
Dim wbThis As Workbook 'Source file


Set wbThis = ActiveWorkbook
strName = ActiveSheet.Name
Set wbTarget = Workbooks.Open("C:\users\desktop\2019 Template.xlsx")


wbThis.Activate
Application.CutCopyMode = False
Range("A:AY").Copy


'paste to master
wbTarget.Activate
Range("A1").PasteSpecial
Application.CutCopyMode = False
wbTarget.SaveAs Filename:="c:\users\desktop\Final\2019 Master" & Range("D2") & ".xlsx"
wbTarget.Close


wbThis.Activate
ActiveSheet.Next.Activate
'Call Test1


Set wbTarget = Nothing
Set wbThis = Nothing


Call Export


End Sub


Sub Test1()
On Error Resume Next
Sheets(ActiveSheet.Index + 1).Activate
If Err.Number <> 28 Then Exit Sub


End Sub

As I said, it's not a vital issue, the code works and does what I want, I just don't want it to have to runtime error when it gets to the last sheet. Thank you in advance!

Hello all,

After much experimentation I've managed to get some loop code working to speed up a project I have.Currently, the code looks through a long worksheet to find a specific name in a column, then, copies the entire row to another worksheet which matches the name required. Then, it saves a copy of that worksheet to a workbook on my desktop.

I was wondering if there was a way to get this information copied in to a template workbook, save that with a specific name, then move on to the next name in the list and repeat the process. Open a template work book containing three worksheets, loop through main workbook to find name X, copy all rows where X exists and copy in to sheet 1 of the template workbook, save as name X, then move on to the next one until complete.

Please see below some code I'm using to do this, as I don't know how to export to an existing workbook, I've had to add in extra bits to format the results (remove blank rows), edit the header row, then save each worksheet to a seperate workbook.

Apologies if the above is a bit too vague, but I was wondering if there was a way to do what I would like. It's no huge issue if not, it will just stop and awful lot of copy pasting.

Sub CopyRows()
'copies info to new worksheet in existing workbook
    Dim bottomL As Integer
    Dim x As Integer
    bottomG = Sheets("ScheduleView").Range("G" & Rows.Count).End(xlUp).Row: x = 2
     
    Dim c As Range
    For Each c In Sheets("ScheduleView").Range("G1:G" & bottomG) 'change the F's to whatever column is required to use, eg coordinator column
        If c.Value = "Peter Griffin" Then
            c.EntireRow.Copy Worksheets("2018 Schedule - P Griffin").Range("A" & x)
            x = x + 1
        ElseIf c.Value = "Randy Marsh" Then
            c.EntireRow.Copy Worksheets("2018 Schedule - R Marsh").Range("A" & x)
            x = x + 1
        ElseIf c.Value = "Butters Stotch" Then
            c.EntireRow.Copy Worksheets("2018 Schedule - B Stotch").Range("A" & x)
            x = x + 1
            
        End If
    Next c
'try and remove the need for lots of calls with case statement s for the C variable. To test.
     'Call DeleteAllBlankCells
     'Call ExportToWorkbooks
End Sub


Sub ExportToWorkbooks()
 Dim NewBook As Workbook, OldBook As Workbook, sh As Worksheet
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
     
   
    Set OldBook = ThisWorkbook
'possibly change the If statement to if portected = false, then export it??? Also consider else if save as excel 97-2003 for the coords with old Excel??
    For Each sh In OldBook.Worksheets
        If sh.Visible = True Then
            sh.Copy
            ActiveWorkbook.SaveAs Filename:=OldBook.Path & "\" & sh.Name, FileFormat:=xlOpenXMLWorkbook 'possibly change to excel 97-2003 with else if?
            ActiveWorkbook.Close
        End If
    Next
     
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
     
End Sub


Sub DeleteAllBlankCells()
    Sheets("2018 Schedule - P Griffin").Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Sheets("2018 Schedule - R Marsh").Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Sheets("2018 Schedule - B Stotch").Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Hello all,

I was hoping someone could offer guidance on the following VBA issue. I have code which creates and saves a text file with specific text while pulling from various cells in an excel sheet, it works fine. Where I'm having problems is, multiple people need to be able to use it, and I'm fed up having to tweak the file path code for every person, I've tried various variable methods and none are working, I'm a very amateurish amateur with code but am learning. Could someone check below and offer guidance with the Environ string and Shells?

The FilePath string saves the file perfectly well on my (other users) desktop, however, I can't get the Shell code to work correctly when referencing the Environ("USERPROFILE") string. The first Shell line works very well, however the users PC must be identified for it to work, defeating the purpose of using the Environ string in the first place.

Can someone please offer advice as to how I could get this to work?

Sub SaveFileandOpen()


Dim TextFile As Integer
Dim FilePath As String


  FilePath = Environ("USERPROFILE") & "\Desktop\" & Range("D6").Value & " File Name " & Format(Now(), "dd mmm yy") & ".txt"
 
  TextFile = FreeFile


  Open FilePath For Output As TextFile


Print #TextFile, "First line of text file here" & _
" second part of first line."
Print #TextFile, ""
Print #TextFile, "Another line here."
 
  Close TextFile
 
  Call OpenWebsite
 
'Shell "C:\WINDOWS\notepad.exe C:\Users\MyPC\Desktop\" & Range("D6").Value & " File Name " & Range("D27").Text & ".txt", vbNormalFocus
Shell "C:\WINDOWS\notepad.exe Environ("USERPROFILE") & "\Desktop\" & Range("D6").Value & " File Name " & Range("D27").Text & ".txt", vbNormalFocus


End Sub

Thank you in advance!

Hello all,

I'm back again now with another annoying issue to do with loops (which, I'm slowly starting to understand but my mind is still being blown). Various tutorials have been looked at, the code below has been taken from Mr Excel and slightly modified but it still won't do exactly what I would like it to.

Background

I have a large spreadsheet of over 5,000 rows of data from columns A to T. This needs to be split across approximately 123 spreadsheets named after a specific nationwide region; Aberdeen City, Aberdeenshire, Angus etc (as shown in column C on the example attached).

Using the code below, I can get it to loop through the data and copy a region to a worksheet within the current workbook fairly successfully. However, there are some annoying issues.

Problems

Number 1. I can't work out how to copy the information to a completely different workbook, only worksheets within the master book. When trying to set a workbook range to a workbook on the server it keeps failing, either I can't type in the file path (red text of doom whatever string I try) or the code just fails. All the files will be stored on a server; A:\Month\Main Folder\Regions\[file name here.xlsx].

Number 2. When running the code as it is, it copies the two regions currently added to worksheets contained within the workbook, however, for Abdereenshire, the data is pasted from row 19, when it should be row 2. What is wrong with the code to make this happen? I have tried varying j yet nothing changes......

I would like this code to copy region X and paste in to region X's workbook stored on a server, then move on to region Z and copy to region Z's workbook and so on.

I've tried to work this out myself but have lost a good few hours trying varying solutions yet nothing is working. It's time to farm this out for any advice I can get. Code is copied below, and spreadsheet attached, all tabs included and code has been run to see what I mean with issue number 2.

Thank you in advance.

Sub CopyRegions()
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet 'ideally should be a seperate workbook on a server
    Dim Target1 As Worksheet ' ideally shoul be a seperate workbook on a server


    Set Source = ActiveWorkbook.Worksheets("Master Sheet")
    Set Target = ActiveWorkbook.Worksheets("Aberdeen City") 'how to set this to a variable book/sheet based on C?
    Set Target1 = ActiveWorkbook.Worksheets("Aberdeenshire") 'how to set this to a variable book/sheet based on C?
    j = 2     ' Start copying to row 2 in target book/sheet
    For Each c In Source.Range("C1:C58") 'Check through all rows on the master sheet based on column C
        If c = "Aberdeen City" Then
           Source.Rows(c.Row).Copy Target.Rows(j)
           j = j + 1
        End If
        If c = "Aberdeenshire" Then
           Source.Rows(c.Row).Copy Target1.Rows(j)
           j = j + 1
        End If
    Next c 'could be a line for each area?
End Sub

Hello Infomage,

Tested it on 10 fake emails and file paths and it seems to work perfectly, thank you very much!

Hello all,

I was hoping someone could help with a problem I'm having. I wish to generate a large number of emails from a list in Excel, but also attach specific files to each email. Please see the attached Excel sheet.

In Column A I will have a long list of email addresses, approximately 180, in Column B I have a list of files which should be attached to a specific email, I can't work out how to get the code to loop through the list of attachments, it loops through and creates the emails perfectly well, the main file, in the code listed under the path F:\2017\Sub\Main File Here.docx, must be included in every single email, however a separate Excel sheet should also be included. Eg: email1 = Excel Sheet 1, email2 = Excel Sheet 2, each email will have a differently named excel sheet.

I know it's probably something every simple, I'm just not able to get anything working.......... Getting very frustrated too. Any help will be greatly appreciated.

Sub SendHTMLEmail()
Dim OutlookApp As Object
Dim MItem As Object
Dim cell As Range
Dim Subj As String
Dim EmailAddr As String
Dim Recipient As String
Dim Msg As String


'Create Outlook object
Set OutlookApp = CreateObject("Outlook.Application")


'Loop through the list of emails in Column A
For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeVisible)
If cell.Value Like "*@*" Then
EmailAddr = cell.Value


'Create email and view before sending. To automatically send all emails, uncomment the .send line at the end.
Set MItem = OutlookApp.CreateItem(olMailItem)
With MItem
'Email Importance. Can be 1 (which is normal), 2 (which is High) or 0 (which is Low).
.Importance = 2
'Read Receipt. Set this to True or False.
.ReadReceiptRequested = True
.To = EmailAddr
.cc = "ourcompanyemailhere"
.Subject = "subject here however long I need"
.HTMLbody = "Dear Sir/Madam," & "<br><br>" & _
"blahdy blahdy blah." & "<br><br>" & _
"moredy moredy more" & "<br><br>" & _
"Kind regards,"
.Attachments.Add ("F:\2017\Sub\Main File Here.docx")
'.Attachments.Add ("variable excel file here")
.Display
'.Send
End With
End If


Next cell


End Sub

Hello all,

I've been modifying some code which was put in place to create a text file which can then be copy pasted as required (a requirement for my job is to create reports on a regular basis, this speeds it up as all I need to do is change a few excel ranges). I want to roll it out to collegues however I want to keep the code locked down to prevent any mishaps. To do this, I need to use the Environ string to create a file on their desktop, however, once done, I would like the file to then be opened to aid copy pasting. Previously, when just myself was using it, I linked it to my desktop only, the file was created and opened perfectly, howeve,r now using the Environ("USERPROFILE") string, it won't open. Could anyone provide guidance on how to get it working?

Please see the code below.

The first Shell line (see end of code) worked fine when FilePath was set to my desktop. Now FilePath is set to Environ("USERPROFILE") it won't work. The second Shell line is shown for info, I have tried varying combinations using quotations and parenthesis around the whole string and small section but to no avail. While automatically opening the file is not necessary for what I need, it will help speed things up.

Sub Createfileandopen()
'This code will create a text file from which information can be copied and pasted as required


Dim TextFile As Integer
Dim FilePath As String


'Code below creates a text file on a users desktop.
  FilePath = Environ("USERPROFILE") & "\Desktop\" & "file name and type here.txt"


'Determine the next file number available for use by the FileOpen function
  TextFile = FreeFile


'Open the text file and generate the text
  Open FilePath For Output As TextFile


'The code below is used for creation of the text file, to add a line seperator, use the following
'code between each paragraph, Print #TextFile, ""
Print #TextFile, "generic text here" & Range("A2").Value & " more text here."
Print #TextFile, ""
Print #TextFile, "some more text here blah blah"


'Save & Close the file
  Close TextFile


'The below code will then open the file and display it after creating, this can then be copy and pasted.
Shell "C:\WINDOWS\notepad.exe C:\Users\USERPROFILE\Desktop\file name and type here.txt", vbNormalFocus
'Shell "C:\WINDOWS\notepad.exe Environ("USERPROFILE") & "\Desktop\" & "file name and type here.txt", vbNormalFocus


End Sub

Any assistance is greatly appreciated.