Posts by ikith

Re: Setting date variable, so I can open files in dated folders using a macro

Quote from Kenneth Hobson;776326

Code

Dim dteProcess As String
  'dteProcess = "8-24-2016"
  dteProcess = Format(Date, "m-d-yyyy")
 
  Workbooks.Open Filename:="C:\Users\mearle\Desktop\" & dteProcess & "\act vs theo.xls"

This seems to be pulling in the current date regaurdless of what dteprocess= is set to.

Edit figured it out, I had to move dteprocess= to after the format set.

Edit2: This worked like a dream, thank you so much! This is going to save me tons and tons of time on having to scroll top to bottom just to change 2 dates for the input and output. I'd donate to you if I were able at this time, but again thank you!

I'm trying to set a date variable (example 8/21/2016) so I can open a file using a date.

Every day I have folders named for the previous day so for example today I have a date labeled 8/24/2016 to pull and process some reports, I have the macros set up nicely but I have to change the following code in the macro to reflect the date:

Workbooks.Open Filename:="C:\Users\USERNAME\Desktop\8-24-2016\FILENAME.xls"

ActiveWorkbook.SaveAs Filename:="C:\Users\USERNAME\Desktop\8-24-2016 Out\FILENAME.xlsm" _
    , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

What I'd like to be able to do instead of having to change both date sections is to have 1 section that I change and it impacts both dates for the open and save part of the macro. I've tried using:

Dim dteProcess As Date
Set dteProcess = '8/24/2016'


Workbooks.Open Filename:="C:\Users\mearle\Desktop\(dteProcess)\act vs theo.xls"

With no avail, however this seems to be what google search is suggesting.

Can anyone point me in the correct direction on how to do this?

Re: Compare GUID and Time to filter

Quote from holycow;718730

If you attach a sample of the export file we can make sure GUID and Time are next to each other.

Here is a sample layout:
forum.ozgrid.com/index.php?attachment/61275/

As you can see GUID is in A and Time is in H and the fields between are usually populated with a lot of data. Its no problem for me to re run my query with a slight modification to --fields to have guid and time next to each other however I also have to space the data out after C, which isn't an issue at all as this does what I need it to do.

Edit: I'm comparing my old way of doing this and the script and the old way is giving me 5470 results while the script is giving me 3396 curious if something is going on.

Re: Compare GUID and Time to filter

Quote from holycow;718699

Provided the data is in the same order as your example, then attached will work

His works perfect, and only requires me to adjust the output of my export to have GUID and Time next to each other, I did have to adjust it to accomidate the 107411 cells but that was relatively easy, thank you!

I've been trying to solve this issue for a couple of hours now, either from the mongodb side or the csv side, it seems like it will be easier to do it from the csv side of things.

What I am trying to do is filter a column called guid by another column called time. The guid field has multiple duplicates and the time is unique per guid.

Sample data:
GUID, Time
6, 1
6, 2
6, 3
7, 4
7, 5
7, 6

The output needs to be:
6, 3
7, 6

Eliminating the duplicate guids by the most recent time.

I know I can kind of do this by sorting the guids then adding a level and sorting time by greatest then eliminating duplicates but when comparing the data I found that it actually eliminated the wrong duplicates and I had data that was older than the most recent.

I don't mean to seem like I'm putting this work on someone else, I am also trying to figure out how to do this on my own.

Re: $60 USD csv/xlsx to kml w/ custom icons in the kml

Quote from Wigi;716403

Hi

Here's a website, including a file and VBA-code.
Probably this is what you need, but I don't know if custom icons are possible.
You might need to choose from an existing list.

I have almost no experience with the KML files so I'd suggest to first try this.

Theres no website attached :\

Re: $60 USD csv/xlsx to kml w/ custom icons in the kml

Quote from Wigi;716400

Thanks!

Is this code for a one-off exercise, or do you need to convert Excel files regularly?

Regularly but the format will be the same each time, it's exported from a database in the same format each time, the output is CSV but I add the date and age fields manually from the formulas in the spreadsheet and usually save it as xlsx.

See OP for updated information.

Re: $60 USD csv/xlsx to kml w/ custom icons in the kml

Quote from Wigi;716398

Hello

Did you pay 10% to Ozgrid? 90% remains afterwards.

Yes $6 has been paid to Ozgrid I apologize if I've named the thread wrong, the total 90% would be $54.

Looking for a VBA within or outside of Excel to convert a sheet to kml with custom icons depending on a fields data.

Sample data provided.
forum.ozgrid.com/index.php?attachment/60971/

The icons need to be as follows (I don't have custom ones made at the moment still working on that part on my end)
10+ Age = 10plus.jpg
20+ Age = 20plus.jpg
80+ Age = 80plus.jpg
90+ Age = 90plus.jpg
140+ Age = 140plus.jpg
150+ Age = 150plus.jpg

All of the data also needs to stay in the KML as a descripction.

Having a bit of trouble, I'm trying to take data in a sheet from SQL and send it to a MSSQL database using a script I've found some code that another user that was trying to do the same thing used (Located here: http://answers.microsoft.com/e…92-4950-8844-9e65f79c9850) and I have made adjustments so it can get to my server, but when I run it I either get:
"An unexpected error occured
Number: -2147217900 Desc: Could not find stored procedure 'dbo.headcountstest" or I get:
"an unexpected error has occured
Number: -2147217887 Desc: Multiple-step OLE DB operation generated errors. Check each OLE DB status value, if available. No work was done."

When removing the rest and using a different script to test the connection, the connection says adOpen, which I assume mean everything is good.

Here is the script I'm using:

Sub WriteSQLData()Dim rst As ADODB.Recordset
Dim cnn As ADODB.Connection
Dim cnnStr As String
Dim rCnt As Long
Dim cCnt As Integer
Dim pKeyFail As Long




On Error GoTo Err_Handler




    'cnnStr = "Provider=MSDASQL.1;Persist Security Info=False;Data Source=sqlExpress;Initial Catalog=Northwind"
    'fill in the gaps with your server information
    cnnStr = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Data Source=127.0.0.1;Initial Catalog=headcounttest"
    
    Set cnn = New ADODB.Connection
    Set rst = New ADODB.Recordset
    cnn.ConnectionString = cnnStr
    cnn.Open
'   Add correct table Ref here
    rst.Open "dbo.headcountstest", cnn, adOpenDynamic, adLockOptimistic
    Sheets("Sheet1").Activate   'change for sheet containing your data
    
    'I'm assuming that data starts at A1 and has fieldnames in row 1
    'and that the columns are in the correct order...blah blah
    
    For rCnt = 2 To Range("A1").CurrentRegion.Rows.Count
            rst.AddNew
                For cCnt = 1 To Range("A1").CurrentRegion.Columns.Count
                    rst.Fields(cCnt - 1) = Cells(rCnt, cCnt).Value
                Next cCnt
            rst.Update
    Next rCnt
    
    If pKeyFail > 0 Then
        MsgBox "A total of " & pKeyFail & " records were not exported due to Primary Key Problems", , "SQL Export"
    Else
        MsgBox "Export Finished", , "SQL Export"
    End If
    
    
    Exit Sub
Err_Handler:
    
    Select Case Err.Number
        Case -2147217873
            pKeyFail = pKeyFail + 1
            Debug.Print Cells(rCnt, 1).Value & "..." & Cells(rCnt, 2).Value
            rst.CancelUpdate
            Resume Next
        Case Else
            MsgBox "an unexpected error has occured" & vbCr & "Number: " & Err.Number & "Desc: " & Err.Description
    End Select
    
    
End Sub

Any help is greatly appreciated.

Re: Combine date and time cells, and move data from cells to match

You sir, are amazing!

I'm stuck, I have a spreadsheet with date spanning across the top and vendor as well as count data running down the side for each day.

What I need is to combine the date and time and move the data accordingly.

For example I have this data:
[ATTACH=CONFIG]57500[/ATTACH]

And I need to move the data like this:
[ATTACH=CONFIG]57501[/ATTACH]

These are just examples, the real sheet is about 1 year and on each day it runs from 09:00 to 04:00.

Re: Compare a row of cells to another worksheet and copy data depending on cell match

Private Sub rocketButton_Click()


    Dim myRng As Range
    Dim lastCell As Long




    'Get the last row
    Dim lastRow As Integer
    lastRow = ActiveSheet.UsedRange.Rows.Count




    'Debug.Print "Last Row is " & lastRow




    Dim c As Range
    Dim d As Range








    Application.ScreenUpdating = False
    
        For Each c In Worksheets("rocketOld").Range("D3:D" & lastRow).Cells
            For Each d In Worksheets("rocketNew").Range("D3:D" & lastRow).Cells
                If (InStr(1, d, c, 1) > 0) Then
                c.Offset(0, 1).Copy
                d.Offset(0, 1).PasteSpecial
                Exit For
            End If
        Next
    Next




'    For Each c In Worksheets("rocketNew").Range("D3:D" & lastRow).Cells
'        For Each d In Worksheets("rocketOld").Range("D3:D" & lastRow).Cells
'            If (InStr(1, d, c, 1) > 0) Then
'                c.Interior.Color = vbRed
'                Exit For
'            End If
'        Next
'    Next




Application.ScreenUpdating = True




End Sub

Re: Compare a row of cells to another worksheet and copy data depending on cell match

Actually solved this, sorry for not editing, will post final code tomorrow.

Re: Compare a row of cells to another worksheet and copy data depending on cell match

Modified my code a little, it's actually not working gives an error of:
Run-time error '1004':

Method 'Range' of object '_Global' failed

Code is now:

Private Sub rocketButton_Click()


    Dim myRng As Range
    Dim lastCell As Long




    'Get the last row
    Dim lastRow As Integer
    lastRow = ActiveSheet.UsedRange.Rows.Count




    'Debug.Print "Last Row is " & lastRow




    Dim c As Range
    Dim d As Range
    Dim CP As Range




    Application.ScreenUpdating = False
    
    For Each CP In Worksheets("rocketOld").Range("E3:D" & lastRow).Cells
        For Each c In Worksheets("rocketOld").Range("D3:D" & lastRow).Cells
            For Each d In Worksheets("rocketNew").Range("D3:D" & lastRow).Cells
                If (InStr(1, d, c, 1) > 0) Then
                Range("CP").Select
                Worksheets("rocketNew").Select
                ActiveSheet.Paste
                Exit For
            End If
            Next
        Next
    Next




'    For Each c In Worksheets("rocketNew").Range("D3:D" & lastRow).Cells
'        For Each d In Worksheets("rocketOld").Range("D3:D" & lastRow).Cells
'            If (InStr(1, d, c, 1) > 0) Then
'                c.Interior.Color = vbRed
'                Exit For
'            End If
'        Next
'    Next




Application.ScreenUpdating = True




End Sub

Re: Compare a row of cells to another worksheet and copy data depending on cell match

No the entire row doesn't need to match, just the serial number.

So what is supposed to happen is if a serial number on rocketNew matches a serial number on rocketOld copy the CEMS ID over to rocketNew.

Edit: I phrased that wrong, it should only be checking the serial numbers, even if there is data that is the same in the row, I only want it to check serial numbers because the other data will change.

Edit2: So I've kinda adapted this script to highlight what it finds as matches from rocketOld to rocketNew possible to adapt this to look once cell over from the matches and paste the CEMS ID to rocketNew instead of highlighting?

Private Sub closeButton_Click()
    Unload Me
End Sub




Private Sub rocketButton_Click()




    Dim myRng As Range
    Dim lastCell As Long




    'Get the last row
    Dim lastRow As Integer
    lastRow = ActiveSheet.UsedRange.Rows.Count




    'Debug.Print "Last Row is " & lastRow




    Dim c As Range
    Dim d As Range




    Application.ScreenUpdating = False




    For Each c In Worksheets("rocketOld").Range("D3:D" & lastRow).Cells
        For Each d In Worksheets("rocketNew").Range("D3:D" & lastRow).Cells
            If (InStr(1, d, c, 1) > 0) Then
                c.Interior.Color = vbRed
                Exit For
            End If
        Next
    Next




'    For Each c In Worksheets("rocketNew").Range("D3:D" & lastRow).Cells
'        For Each d In Worksheets("rocketOld").Range("D3:D" & lastRow).Cells
'            If (InStr(1, d, c, 1) > 0) Then
'                c.Interior.Color = vbRed
'                Exit For
'            End If
'        Next
'    Next




Application.ScreenUpdating = True




End Sub

Re: Compare a row of cells to another worksheet and copy data depending on cell match

Sample attached

What I'm trying to do is make a script that depending on what button pressed will compare a row on two sheets (For example rocketOld and rocketNew) then depending on if it finds a match will copy data from rocketOld to rocketNew from one cell to the right of the compared row to the right side of the row that was matched.

I've tried googling around to find a script similar that I can adapt but no luck.

Re: $100 - Visual Basic Schedule Organizer

Amazing! Thank you so much.

Re: $100 - Visual Basic Schedule Organizer

SMC PMed me saying the spreadsheet is completed, payment made, waiting on SMC to post.