Replacing Specific XL Page

[DMT Dave]

Hi Guy's hope you are all well, This following code was posted on here and works totally fantastic

This Transfers all contacts from database to Excel file and generates excel pages A-Z and transfers Contacts starting with A to Excel sheet A, Transfers Contacts Starting with B to Excel sheet B through to Z

If we change Name on the Database for example starting with M so Michael has changed to Mick, can this code be adapted where:

My thought of Option (1)
I have text box perhaps called txtInitial
I type M in that text box
A piece of this code just updates the Excel Page called M and doesn't generate new pages from A-Z ?

My thought of Option (2)
I am unsure if it's easier to delete pages A-Z then run the code I have so you guy's may advise an adaption of this code that deletes pages and use this code to generate new again ?

Note: I want to keep this code as works fab, I think ranman posted it

Note: these XL sheets are from sheet 4 as the first 3 sheets are template sheets to copy contacts from, So I DO NOT WANT TO DELETE the FIRST 3 Sheets only where the sheet names are A-Z


Much appreciated

Dim sSql As String, srcPath As String, srcFile As StringDim vChr
Dim i As Integer
Dim qdf As QueryDef
Const kQRY = "qsNames2Export"
Dim vFile, vLtr




On Error Resume Next


srcPath = "T:\DMT Ltd\XL Files\"
srcFile = "Contacts.xlsx"


vFile = srcPath & srcFile




 sSql = "select * from tblDealers where left(ucase([Name]),1)<='A'"
Set qdf = New QueryDef
qdf.Sql = sSql
qdf.Name = kQRY
CurrentDb.QueryDefs.Append qdf




For i = 65 To 90
     vLtr = Chr(i)
     If i = 65 Then   'A or less
        sSql = "select tblDealers.Name, tblDealers.Town, tblDealers.Postcode from tblDealers where left(ucase([Name]),1)<='" & vLtr & "' ORDER BY tblDealers.Name, tblDealers.Name;"
     Else
        sSql = "select tblDealers.Name, tblDealers.Town, tblDealers.Postcode from tblDealers where left(ucase([Name]),1)='" & vLtr & "' ORDER BY tblDealers.Name, tblDealers.Name;"
     End If
     
     Set qdf = CurrentDb.QueryDefs(kQRY)
     qdf.Sql = sSql
     qdf.Close
     
     DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, kQRY, vFile, True, vLtr
Next
Set qdf = Nothing

[Welshgasman]

I would change the criteria for the loop, start and finish.
For M, you would have For i = 77 to 77

[Micron]

Comments/questions if I may:

Why test if i = 65 when it was just set to be 65 with the For Next loop?

On Error Resume Next is probably just to handle when qdf already exists. Not a fan of basically disabling error trapping as that means there could be subsequent related errors.
I would try a temp qdf instead.

One thing I don't get is why the 2 sql's? In the 1st, vLtr can only be 65, which is A, and it cannot be less than 65 (<= vLtr), so the 2nd one is all that's needed? I wouldn't bother with vLtr either as it's only 2 characters less than Chr(i) and is easier to follow.

I would probably turn this into a sub that takes a string such as "All" or one letter in order to solve the current issue. Probably could even take a range such as E to H if that would help.

EDIT - @DMT Dave; after 615 posts I hope you have a field named Name only because that's what you were given to work with.

[Micron]

Perhaps

Sub ReplaceSheets(strOption As String)
Dim sSql As String, srcFile As String, ary() As String
Dim db As DAO.Database, qdf As DAO.QueryDef
Dim i As Integer
Dim vFile

On Error GoTo errHandler
vFile = "T:\DMT Ltd\XL Files\Contacts.xlsx"
Set db = CurrentDb
ary() = Split(strOption, ",")
For i = 0 To UBound(ary)
  sSql = "SELECT [Name], Town, Postcode From tblDealers WHERE Left([Name],1) = '"
  sSql = sSql & UCase(ary(i)) & "' ORDER BY tblDealers.Name;"  'why was Order By field in 2x?
  Set qdf = db.CreateQueryDef("", sSql)
  ''DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, qdf.Sql, vFile, True, Ucase(ary(i))
  MsgBox Ucase(ary(i))
  MsgBox qdf.sql
Next

exitHere:
Set qdf = Nothing
Set db = Nothing
Exit Sub

call as
replacesheets "a,b,f"

I could only test without the transferspreadsheet part of course. Test with msgbox first, then comment out and try transfer.

One could handle conditions such as invalid inputs (e.g. numbers or leading/trailing commas) but some onus has to be put on the user to enter only " followed by comma separated letters, followed by " as shown, or just "a" or "A".

[DMT Dave]

Thank you guys, If i have read your question correctly and perhaps i should have also mentioned, if for example a name starts with a number such as:

1way ticket
2 way return
Andrew
Alan
is in sheet A

Then these are being list in XL Sheet A

Does this answer ?

[DMT Dave]

WGM what does 77 to 77 represent ? I think my lack of understanding on that and why I have do I initially have 65 to 90 ? again my lack of understanding

So what would "66 to 66" do ? "55 to 55" do ?

I don't know what this range is for, i know what i have works great on sending all contacts to a relevant sheet, it does add new sheets called A-Z then adds the data correctly

I guess i am looking for something like if txtInitial = M then open the Xl file on page M and update that page range only where contacts start with M same applies if txtInitial starts with A,B, C etc

Apologies for my lack of understanding

[DMT Dave]

I am going to try Microns suggestion

[Welshgasman]

WGM what does 77 to 77 represent ? I think my lack of understanding on that and why I have do I initially have 65 to 90 ? again my lack of understanding

So what would "66 to 66" do ? "55 to 55" do ?

I don't know what this range is for, i know what i have works great on sending all contacts to a relevant sheet, it does add new sheets called A-Z then adds the data correctly

I guess i am looking for something like if txtInitial = M then open the Xl file on page M and update that page range only where contacts start with M same applies if txtInitial starts with A,B, C etc

Apologies for my lack of understanding

You are going through the alphabet A-Z using the ASC number for the initial character.
M is 77, so I was suggesting that you amend the loop to determine what characters you need to process?

You could have a multi select listbox with the initials and a checkbox to select all, and then process that list box, so if you only select D and M, they are the only ones processed?

[DMT Dave]

Are you able to paste a code example for me to try and understand ?

[DMT Dave]

I Know what you mean by mulitselect list box and a check box to select the full list, or perhaps as my thought a text box txtInitial and a select all check box so

If txtInitial = "" Then
If checkbox = true
Update A-Z
Else
Update txtInitial

etc... for space reasons on my form this would work better for me but it's knowing how to open the XL no need to be visible and update specific Sheet Name dependant on check box or txt Initial ?

[Welshgasman]

Are you able to paste a code example for me to try and understand ?

No, I am off to a hospital appointment now anyway.
You could combine my idea with Micron's method and just pass in what initials you wish to generate?

[DMT Dave]

Great stuff WGM and Micron, good luck and i will test a few things, just racked this code up and adjusted from various other code i have, do i dare try it!!!

I have made a copy of my original anyway, does this look like it would clear specific sheet and re add from recordset ?, note the txtinitals gets the first letter of contact name by clicking on a list of names in a form datasheet view

So im trying to make it so that a contact name is not clicked and the txtinitial box is empty then abort the event, note: I have added Dim myLetter as string

If Me.cboContactOptions = "Update A-Z Range PO Sheet" ThenmyLetter = Forms!frmMainMenu!frmIndex9!txtInitial
    If myLetter = "" Then
    MsgBox ("You Need To Click On A Contact Name Starting With The Relevant Letter"), vbInformation + vbOKOnly, "NO PAGE TO UPDATE"
    DoCmd.CancelEvent
    Else
    Set xl = CreateObject("Excel.Application")
    Set xlWrkBk = GetObject(srcPath & srcFile)
    Set xlsht = xlWrkBk.Worksheets(myLetter)
        iLastRow = xlsht.UsedRange.Rows.Count
        xlsht.Cells.ClearContents
    If MsgBox("Contacts Starting With Letter: " & myLetter & " " & "Are Now Cleared" & vbNewLine & vbNewLine & _
    "Update All Contacts Starting With The Letter: " & myLetter & " " & "?", vbQuestion + vbYesNo, "UPDATE NOW ?") = vbNo Then
        DoCmd.CancelEvent
    Else
        Set rs = CurrentDb.OpenRecordset("Select tblDealers.Name, tblDealers.Town, tblDealers.Postcode From tblDealers WHERE Left([Name]) = '" & myLetter & "'")
        xlsht.Cells(1, 1).CopyFromRecordset rs
        xl.Quit
        Set xl = Nothing
        Set xlWrkBk = Nothing
        Set xlsht = Nothing
    End If
    End If
End If

[Welshgasman]

Indent your code correctly please.
So what happens if you want to do the whole alphabet, or most of it?

[DMT Dave]

it would either be 1 letter at a time ie M or A or B

As the initial output worked, Wouldn't need to output the alphabet again just as and when a company, customer name changes

[Welshgasman]

Indenting correctly is going to0 help a lot when you make mistakes?

If Me.cboContactOptions = "Update A-Z Range PO Sheet" Then
    myLetter = Forms!frmMainMenu!frmIndex9!txtInitial
    If myLetter = "" Then
        MsgBox ("You Need To Click On A Contact Name Starting With The Relevant Letter"), vbInformation + vbOKOnly, "NO PAGE TO UPDATE"
        DoCmd.CancelEvent
    Else
        Set xl = CreateObject("Excel.Application")
        Set xlWrkBk = GetObject(srcPath & srcFile)
        Set xlsht = xlWrkBk.Worksheets(myLetter)
        iLastRow = xlsht.UsedRange.Rows.Count
        xlsht.Cells.ClearContents
        If MsgBox("Contacts Starting With Letter: " & myLetter & " " & "Are Now Cleared" & vbNewLine & vbNewLine & _
                  "Update All Contacts Starting With The Letter: " & myLetter & " " & "?", vbQuestion + vbYesNo, "UPDATE NOW ?") = vbNo Then
            DoCmd.CancelEvent
        Else
            Set rs = CurrentDb.OpenRecordset("Select tblDealers.Name, tblDealers.Town, tblDealers.Postcode From tblDealers WHERE Left([Name]) = '" & myLetter & "'")
            xlsht.Cells(1, 1).CopyFromRecordset rs
            xl.Quit
            Set xl = Nothing
            Set xlWrkBk = Nothing
            Set xlsht = Nothing
        End If
    End If
End If