VBA code from Excel not working in Access (1 Viewer)

LostandConfused

New member
Local time
Today, 18:09
Joined
Feb 8, 2013
Messages
6
A while back I created an Excel Macro that converts a plain spreadsheet we commonly get into a format that makes it easy to track items and removes all the columns I dont use. Well recently people want that macro from other organizations, and since I cannot figure out how to explain to them how to set it up I created an Access database that would import the document, and export it with all my nifty modifications. Only problem is, my VBA code from Excel is not working right in Access. I have discovered a way around it for most lines of code and I am going line by line fixing it, but one line will not work no matter what I try. It is a simple Replace function, the dates from the original document are stored as text and have "-" in them; I simply want to replace the "-" with a space " " but the same code that works great for this in Excel is not working in Access. I am using Access 2007, here is my code:
Code:
Private Sub Export_EPR_Tracker_Click()
Dim FreshFile As String
FreshFile = FileOpenDialog
Dim dAt As String
dAt = " " & Format(Now(), "dd-mmm-yy")
Dim pA As String
pA = "C:\Users\nathan.mitson.AVIANO\Documents\MS Practice Stuff\EPR Trackers\EPR Tracker" & dAt & ".xlsx"

DoCmd.TransferSpreadsheet acExport, 10, "Alpha Roster Import", pA, True
Dim xlApp, xlBook As Object
Dim xlSheet As Object
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.workbooks.Add(pA)
Set xlSheet = xlApp.workbooks.Open(pA).sheets(1)
xlApp.Visible = True

    Dim EPRDue1 As Variant
    Dim EPRDue2 As Variant
    Dim Val1 As Variant
    Dim Val2 As Variant
    Dim Val3 As Variant
    Dim x As Variant
    Dim LResult As String
    
With xlApp
.Application.sheets("Alpha_Roster_Import").Select
    a = xlApp.Application.WorksheetFunction.CountA(xlApp.Range("B:B"))
    x = 2
    .Columns("C:C").Select
    .Selection.Cut
    .Columns("A:A").Select
    .Selection.Insert Shift:=xlToRight
    .Range("C:E, G:W, Y:AA, AC:AF, AH:AI, AK:AM, AO:BH").Delete
    .Columns("G:G").Select
    .Selection.Cut
    .Columns("E:E").Select
    .Selection.Insert Shift:=xlToRight
    .Columns("H:H").Select
    .Selection.Cut
    .Columns("D:D").Select
    .Selection.Insert Shift:=xlToRight
    .Columns("G:G").Select
    .Selection.Insert Shift:=xlToRight, _
        CopyOrigin:=xlFormatFromLeftOrAbove
    .Columns("G:G").Select
    .Selection.Insert Shift:=xlToRight, _
        CopyOrigin:=xlFormatFromLeftOrAbove
    .Range("D:D, F:F, I:J").Select
**.Selection.Replace What:="-", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    .Range("G1").Value = "DUE TO FLT"
    .Range("H1").Value = "DUE TO SQ"
    .Range("H2:H" & a).Formula = "=RC[1]-30"
    .Range("G2:G" & a).Formula = "=RC[2]-45"
    'Do
        'Val1 = xlApp.Range("D" & x)
        'Val2 = xlApp.Range("J" & x)
        'Val3 = xlApp.Range("F" & x)
        'EPRDue1 = Val1 - Val2
        'EPRDue2 = Val1 - Val3
        'If EPRDue1 > 120 And EPRDue1 < 364 And EPRDue2 > 120 Then
        '.Range("I" & x).Value = xlApp.Range("D" & x) - 30
        'End If
    
        'x = x + 1
    'Loop While x <= a
    '.Cells.Select
    '.Selection.WrapText = False
    '.Cells.EntireColumn.Autofit
    '.Cells.EntireRow.Autofit
    '.Cells.Select
    '.Selection.AutoFilter
    '.Range("D2").Select
    '.ActiveWindow.FreezePanes = True
    '.Range("G:I").Select
    '.Selection.FormatConditions.Add Type:=xlCellValue, _
        'Operator:=xlLess, Formula1:="=TODAY()"
    '.Selection.FormatCondition._
        '(Selection.FormatConditions.Count).SetFirstPriority
   ' With Selection.FormatConditions(1).Interior
        '.PatternColorIndex = xlAutomatic
        '.Color = 255
        '.TintAndShade = 0
    'End With
    '.Selection.FormatConditions.Add Type:=xlCellValue, _
        'Operator:=xlBetween, Formula1:="=TODAY()", _
        'Formula2:="=TODAY() + 5"
    '.Selection.FormatConditions_
        '(Selection.FormatConditions.Count).SetFirstPriority
    'With Selection.FormatConditions(1).Interior
        '.PatternColorIndex = xlAutomatic
        '.Color = 65535
        '.TintAndShade = 0
    'End With
    '.ActiveSheet.Range("$A$1:$J$434").AutoFilter Field:=3, _
    'Criteria1:=Array("MXAB", "mxaba", "MXABC", "MXABD", "MXABF", _
    '"MXABG", "MXABS", "mxabw"), Operator:=xlFilterValues
  
End With
Set xlApp = Nothing
Set xlBook = Nothing
End Sub

I am stuck on the line with the * in front. All the ' marks indicate lines of code from Excel that I haven't proven yet. All I need help with at the moment though is the * line. Any help would be greatly appreciated, I feel like I am going to pull all my hair out, lol.
 

DonkeyKong

Registered User.
Local time
Today, 11:09
Joined
Jan 24, 2013
Messages
61
Lol at how this forum dies as soon as the work day ends and especially on weekends. That's some nice coding. I probably won't be much help to you but I'll try.

From what I've noticed with my recent experimentation with access is that most of the key words from xcel don't really translate to access. So, the first question is why use access now if excel has been satisfactory in the past?

Second, if you are wanting to adjust the sheet in the way you are specifying, you should do it before you transfer it. Once it is transferred, I'm pretty sure that you cannot adjust it in the way you are trying to. So try putting your

DoCmd.TransferSpreadsheet acExport, 10, "Alpha Roster Import", pA, True

at the end of all of your spreadsheet edits.

If that works, it wouldn't be as efficient necessarily, but if all that other stuff works you could just go through the date column cell by cell in a loop and remove the - character.

I could be wrong, but it looks like the code was probably originally generated by the macro recorder in excel. So as long as you're not married to the coding, there are almost always other ways to rewrite code. If you want to do that, post up an example of the spreadsheet so we can get an idea of what you're trying to do.

Also, you may want to just comment the

**.Selection.Replace What:="-", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

line out and see if the rest of the code works.
 

LostandConfused

New member
Local time
Today, 18:09
Joined
Feb 8, 2013
Messages
6
Thank you for the reply. Sorry, it appears I missed some key info in my first post so I will try to answer them now. First the reason I can no longer continue with excel is because I was using access just for myself, with my own personal macro, but now my bosses have seen what I did with it and now they want me to go around and load the macro to everyones computer who wants it... not something I want to do if I can avoid it. So I thought I would create an access document that was easy to use, tha way whenever a new document comes out anyone on the network could just click an import button and and export button and be done. Where I work people are extremely computer eliterate which again leads me toward an access document. And lastly, unfortunately I cannot post the spreadsheet here because it is used to track an obsene amount of personal information about the members of my organization.
Oh and thanks for the complement, some of what is in there is rendered from the record feature of excel, but most of if from my self teaching from google and sites like this one. Thanks again for any help you can provide.
 

LostandConfused

New member
Local time
Today, 18:09
Joined
Feb 8, 2013
Messages
6
Oh and yes it works at least for a few more lines without that line included. There is just something about that line that is written funky.
 

DonkeyKong

Registered User.
Local time
Today, 11:09
Joined
Jan 24, 2013
Messages
61
Very cool. Here is a solution to the problem. I am assuming that the "-" is in the same place everytime. In this example i have the dates formatted as "xx-xxxx" or "10-2012".

Code:
Function changeDate()
Dim xSpot As Integer
Dim myDate, newMyDate, firstPart, secondPart As String
xSpot = 1
myDate = Sheet1.Cells(xSpot, 4)
Do While myDate <> ""
    firstPart = Left(myDate, 2) & " "
    secondPart = Mid(myDate, 4, 4)
    newMyDate = firstPart & secondPart
    Sheet1.Cells(xSpot, 4).Value = newMyDate
    xSpot = xSpot + 1
    myDate = Sheet1.Cells(xSpot, 4)
Loop
End Function
 

LostandConfused

New member
Local time
Today, 18:09
Joined
Feb 8, 2013
Messages
6
Thank you very much, I had to change things on it a little for a three part date as well as rewording a little because I kept getting errors. A lot of it is probably unnecessary but the fact that I was even able to understand it enough to do this makes me pretty excited, Thank you again. Oh and here's the finished code.
Code:
        b = 2
        myDate = xlApp.Range("D" & b)
        Do
            firstPart = Left(myDate, 2) & " "
            secondPart = Mid(myDate, 4, 3) & " "
            thirdPart = Mid(myDate, 8, 4)
            newMyDate = firstPart & secondPart & thirdPart
            xlApp.Range("D" & b).Value = newMyDate
            b = b + 1
            myDate = xlApp.Range("D" & b)
        Loop While b <= a
        
        b = 2
        myDate = xlApp.Range("I" & b)
        Do
            firstPart = Left(myDate, 2) & " "
            secondPart = Mid(myDate, 4, 3) & " "
            thirdPart = Mid(myDate, 8, 4)
            newMyDate = firstPart & secondPart & thirdPart
            xlApp.Range("I" & b).Value = newMyDate
            b = b + 1
            myDate = xlApp.Range("I" & b)
        Loop While b <= a
        
        b = 2
        myDate = xlApp.Range("J" & b)
        Do
            firstPart = Left(myDate, 2) & " "
            secondPart = Mid(myDate, 4, 3) & " "
            thirdPart = Mid(myDate, 8, 4)
            newMyDate = firstPart & secondPart & thirdPart
            xlApp.Range("J" & b).Value = newMyDate
            b = b + 1
            myDate = xlApp.Range("J" & b)
        Loop While b <= a
 

gemma-the-husky

Super Moderator
Staff member
Local time
Today, 17:09
Joined
Sep 12, 2006
Messages
15,653
out of interest, where does the spreadsheet come from - if it originally comes from a csv, say, it would be MUCH safer to try and work with the original csv, than the excel sheet - one reason is that simply loading a csv into excel can change stuff.

also, importing excel can lead to problems with column types - which is rarely an issue with csvs.
 

LostandConfused

New member
Local time
Today, 18:09
Joined
Feb 8, 2013
Messages
6
I honestly don't know where the original comes from. We just get them sent to us about once a week from another organization, its completely raw and we end up reformatting it every time.
 

gemma-the-husky

Super Moderator
Staff member
Local time
Today, 17:09
Joined
Sep 12, 2006
Messages
15,653
Ok

can you not give the users an excel macro/code to tidy up their data sheets - rather than doing it all in access.
 

LostandConfused

New member
Local time
Today, 18:09
Joined
Feb 8, 2013
Messages
6
They dont know how to set up a macro, and I dont want to have to set them all up only to do it again if it changes. I wanted an access database so that if someone requests a modification, I can do it once, or maybe even give it the capability of kicking out different types of products. Plus its fun learning access :)
 

Users who are viewing this thread

Top Bottom