Posts by neuralgroove

neuralgroove · Jul 12th 2005

Re: Naming Freeform Objects

not sure if this is what you're looking for. you should be able to change the name of the shape by just typing the new name in the Name Box you can do it through code too

Code

ActiveSheet.Shapes("Freeform 2").Select
    Selection.Name = "FunnyShape"
    Selection.ShapeRange.ScaleWidth 1.37, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 1.4, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.IncrementLeft -59.25
    Selection.ShapeRange.IncrementTop 83.25

neuralgroove · Jul 11th 2005

Re: Using a variable as a filename

there are a number of alternatives for specifying the folder by this is the simplest

Code

Sub saveworkbookasinputfilename()
saveasfilename = InputBox("Please Enter The name for the file", "Enter File Name")
saveasfilefolder = "C:\Mypath\"
ActiveWorkbook.SaveAs saveasfilefolder & saveasfilename & ".xls"
End Sub

neuralgroove · Jun 3rd 2005

Re: Using stored procedures with VBA

this is a stripped down version of a procedure that I use that calls a stored procedure in access, so the connection strings would be different, but I think the recordset call would be in SQLServer

Code

Sub total_sites()
    Dim con    As ADODB.Connection
    Dim cmd    As ADODB.Command
    Dim rs     As ADODB.Recordset
    Dim par    As String
    Dim WSP    As Worksheet
    Set con = New ADODB.Connection
    Set cmd = New ADODB.Command
    Set rs = New ADODB.Recordset
    Set WSP = Worksheets("Data_Dump")
    WSP.Cells.Clear
    con.Open "MASTERDSN"
    cmd.ActiveConnection = con
    cmd.CommandText = "totalsites_new" '<--Name of Stored Procedure
    par = InputBox("Enter Start Date", "Total Sites Query")
    Set rs = cmd.Execute(, par, adCmdStoredProc)
    WSP.Activate
    If rs.EOF = False Then WSP.Cells(1, 1).CopyFromRecordset rs
    rs.Close
    con.Close
    Set rs = Nothing
    Set con = Nothing
End Sub

Display More

neuralgroove · Jun 2nd 2005

Re: Multiple Columns

then use this

Code

range(cells(1,1),cells(1,NumCols)).entirecolumn.select

neuralgroove · Jun 2nd 2005

Re: Reverse a list of names

This should do it. Its not elegant, but make sure that NameColumn is set to the right column (ColumnA=1, Column B=2 etc)

Code

Sub Name_Extractor()
    
NameColumn = 2 'Column Your Names Are In
er = Cells(65000, NameColumn).End(xlUp).Row
TempColumn = ActiveSheet.UsedRange.Columns.Count + 1 'first empty column after your data ends
For x = 1 To er
        NameString = Cells(x, NameColumn)
        LengthString = Len(NameString)
        ColumnCount = TempColumn
        IndName = ""
        For CountLetter = 1 To LengthString    'Extract The Individual Names
            SingleLetter = Mid(NameString, CountLetter, 1)
            If SingleLetter <> ";" Then
                IndName = IndName & SingleLetter
            Else
                Cells(x, ColumnCount) = Trim(IndName)
                IndName = ""
                ColumnCount = ColumnCount + 1
            End If
        Next CountLetter


        For NameCount = TempColumn To ColumnCount - 1    'Change the individual Names
            IndName = Cells(x, NameCount)
            LengthName = Len(IndName)
            counter = 0
            Do
                SingleLetter = Mid(IndName, LengthName - counter, 1)
                counter = counter + 1
            Loop Until SingleLetter = " "
            LastName = Trim(Right(IndName, counter))
            FirstName = Trim(Left(IndName, LengthName - counter))
            Cells(x, NameCount) = LastName & ", " & FirstName
        Next NameCount
        NameString = ""
        For NameCount = TempColumn To ColumnCount - 1
            NameString = NameString & Cells(x, NameCount) & "; "
        Next NameCount
        Cells(x, NameColumn) = NameString
        Range(Cells(x, TempColumn), Cells(x, ColumnCount)).ClearContents
    Next x
End Sub

Display More

neuralgroove · Jun 2nd 2005

Re: Reverse a list of names

Do any of the initials have periods after them, is there always a middle initial, are they always separated by semicolons?

neuralgroove · Jun 2nd 2005

Re: Multiple Columns

or

Code

range(cells(1,startcol),cells(1,endcol)).entirecolumn.select

neuralgroove · Jun 2nd 2005

Re: Change fill color based on criteria

is the file that I sent to you not working?

neuralgroove · Jun 1st 2005

Re: Check cells and change others depending on value

set ws1 and ws2 as your worksheet names and try this

Code

Sub Region()
    Dim ws1    As Worksheet
    Dim ws2    As Worksheet
    Dim r      As Integer
    Dim count  As Integer
    Dim i      As Integer


    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    i = 76
    count = ws1.Cells(65536, 8).End(xlUp).Row
    For r = 2 To count
        Select Case ws1.Cells(r, 8)
            Case "3C"
                ws2.Cells(r, 1) = "Central"
            Case "3W"
                ws2.Cells(r, 1) = "West"
            Case "3U"
                ws2.Cells(r, 1) = "North"
            Case "3S"
                ws2.Cells(r, 1) = "South"
        End Select
        i = i + 1
    Next r
End Sub

Display More

neuralgroove · Jun 1st 2005

Re: Check cells and change others depending on value

it looks like the rows and columns in your cells() statements are mixed up. If r is referring to the row, the it should be cells(r,8).select etc.
I could be wrong, but this code is going to scan through row 8 in the first sheet up to the count of rows in columnb 8 and then change the values in row 1 of the next sheet.

neuralgroove · Jun 1st 2005

Re: Deleting rows with similar columns

this will allow for blanks and delete rows if all the columns are blanks, not quite as elegant, but it does the job.

Code

Sub delete_rows_with_duplicate_column_entries()
    Application.Calculation = xlCalculationManual
    er = Cells(65000, 1).End(xlUp).Row
    For x = 1 To er
        If x > er Then Exit Sub
        Cells(x, 1).Activate
        If ActiveCell.Offset(0, 1) = ActiveCell Then
            ActiveCell.EntireRow.Delete
            x = x - 1
            er = er - 1
        End If
    Next x
    Application.Calculation = xlCalculationAutomatic
End Sub

Display More

neuralgroove · Jun 1st 2005

Re: Creating a Formula

in column I
"=vlookup(H1,$A$1:$B$14,2,false)"

neuralgroove · Jun 1st 2005

Re: comparing worksheets

put a countif formula into Sheet1 column B ("=countif(Sheet2!$A$1:$A$65000,A1")
then autofilter Column B for Zeros, and copy and paste to Sheet 3

neuralgroove · Jun 1st 2005

Re: Deleting rows with similar columns

when you are in the VB Editor, make sure the code is placed in a module in the same workbook. Open the Project Explorer window and locate your file, then click Insert -> Module and paste it there. Make sure you save your file before you run the macro just in case it does something you don't want it to do. Also make sure that the cell it is starting in isn't blank, or else it will end the macro.

neuralgroove · Jun 1st 2005

Re: SaveAs Text with nested quotation marks

I'm not sure I understand, is <preset 1> File ="d:/tickers/news_tickers/weather"<preset"1"/>
then name of the text file?

neuralgroove · Jun 1st 2005

Re: Deleting rows with similar columns

this should work. Makesure that it is starting in the right place ("A1" if there are no column headers, "A2" if there are). I called the calculation part because it will probably speed up the code.

Code

Sub delete_rows_with_duplicate_column_entries()
    Application.Calculation = xlCalculationManual
    Range("A1").Activate 'make sure this is your starting cell
    While Not IsEmpty(ActiveCell)
        If ActiveCell.Offset(0, 1) = ActiveCell Then
            ActiveCell.EntireRow.Delete
        Else
            ActiveCell.Offset(1, 0).Activate
        End If
    Wend
    Application.Calculation = xlCalculationAutomatic
End Sub

Display More

neuralgroove · Jun 1st 2005

Re: getting the entire row from worksheet corresponding to a cell found

actually, i thought about it for a second. If you have a listbox and you want rows and columns then you have to make a multicolumn listbox and import each cell individually. You can import a row into a listbox. If you need help with that then there are tons of posts in ozgrid and elsewhere on populating a multicolumn listbox.

neuralgroove · Jun 1st 2005

Re: getting the entire row from worksheet corresponding to a cell found

try

Code

ListBox1.AddItem = Worksheets(1).Row(c.row)

neuralgroove · Jun 1st 2005

Re: Count letters till you get to a number

as long as you data is in column "A" this should do the trick

Code

Sub countletters()
    For rownum = 1 To Cells(65000, 1).End(xlUp).Row
        num_string = ""
        For x = 1 To Len(Cells(rownum, 1).Value)
            Cells(rownum, 2) = Mid(Cells(rownum, 1).Value, x, 1)
            Cells(rownum, 3).FormulaR1C1 = "= RC[-1]*1"
            If Not IsError(Cells(rownum, 3)) Then num_string = num_string & Cells(rownum, 2)
        Next x
        Cells(rownum, 2) = num_string * 1
        Cells(rownum, 3).ClearContents
    Next rownum
End Sub

Display More

neuralgroove · Jun 1st 2005

Re: Determine if blank worksheet

the End keyword stops the whole procedure

Code

If PageCount = 0 Then end