Quantcast
Channel: Excel Help Forum - Excel Programming / VBA / Macros
Viewing all 50013 articles
Browse latest View live

Function to sort a cell alphabetically with no regard for the data

$
0
0
Hello,

I work in eDiscovery and I have a bunch of data that I'm attempting to make hashes for. Unfortunately, this data has emails that were stored in a program called Bloomberg Vault. It seems when an email is stored in Bloomberg Vault it puts all email addresses in alphabetical order. Because we are loading data that wasn't stored in this program and data that was stored in this program we are unable to generate matching hashes for the data.

I originally concatenated the data in SQL and assumed there was a function built-in that would alphabetize the data. Unfortunately, this isn't actually a function as I needed it in SQL. Then, I figured I would be able to wing it in Excel, but haven't found the particular solution I need. I found a function that sorts a cell based on a delimiter, and that almost works for me, except I don't have consistent delimiters in the data. I could insert them at concatenation in SQL, but these are many thousands of characters long cells of data and it wouldn't be possible for me to verify that the delimiters went into equal places.

So, an example. I have two strings one looks like <TO: David, Larry@cye.org; Benes, Elaine@seinfeld.org;> and another string that is the opposite <TO: Benes, Elaine@seinfeld.org; David, Larry@cye.org;>. (These strings also contain FROM, CC, BCC, Subject, and IntMsgID).

I need a function that just sorts all of the cell in alphabetical order, spaces can be ignored, but symbol characters need to have a consistent sort as well. Because I'm just making a hash I don't care what the data looks like afterward. I want both strings to look like
<>:,,@@;;>aaabcddeeeeeefggiiillnnnooorrrrsstvy

After I have those strings sorted alphabetically I'll be able to plug them back into SQL, then use HashBytes on them to generate the hashes. I appreciate if anyone can help.

Thank you,

Joe Halvarson

[SOLVED] Move data to second workbook without showing that workbook

$
0
0
being fairly new to VBA I have a code to put data from user form to second workbook, however if the second workbook is open it will not insert data. I would also like to enter data without the second workbook showing. Both workbooks a password protected, I know I need to insert Password, but where? I have included what I have now. Thanks in advance for the help.

Code:

Sub subExtractFish()

        Dim nwb As Workbook

        Set nwb = Workbooks.Open("\\C:\Users\Bob\Desktop\Res-C.xlsm")

        With nwb.Sheets("Rider")
                    Dim qsrch As Range
                    Dim d As Range
                       
       
            Set d = .Range("N5000").End(xlUp).Offset(1, 0)
                d.Offset(0, 0).Value = txtTd.Value
                d.Offset(0, 1).Value = txtNa.Value
                d.Offset(0, 2).Value = txtTic.Value
                d.Offset(0, 3).Value = txtAm.Value
        End With
                    Dim rsrch As Range
                    Dim e As Variant
                    Dim f As Variant
       
        With nwb.Sheets("Report")
            Set rsrch = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
        End With
         
        With rsrch
            Set e = .find(txtTd, LookIn:=xlValues, lookat:=xlWhole)
            Set f = .Range("A3").Range("A65536").End(xlUp).Offset(1, 0)
        End With
               
        With nwb.Sheets("Report")
          If Not e Is Nothing Then
                e.Offset(0, 3) = e.Offset(0, 3) + txtAm
                e.Offset(0, 40) = e.Offset(0, 40) + 1
          Else
                f.Offset(0, 0) = txtTd
                f.Offset(0, 3) = f.Offset(0, 3) + txtAm
                f.Offset(0, 37) = txtTd
                f.Offset(0, 40) = f.Offset(0, 40) + 1
               
          End If
        End With
        nwb.Close True
End Sub

Excel validation data to run macro..

$
0
0
Hi,

I am working with 2 macro, 1 is for english and another one for french.
They are called. MacroEng, and MacroFre. All they do is format column and rows, and merge data. Nothing too important.
Now, in a master sheet, I have created a button to click open an excel file. Now, I want to be able to:
If the selected open file contains in cell A4 : Sommaire, then run MacroFre.
If the selected open file contains in cell A4: Summary, then run MacroEng.

This way, I won't need to add 2 separate button for French, or English. But only 1 button can do the job.

Here is my macro to call an open selected file:
Code:

Sub Single_Fre()
  Dim wb                          As Excel.Workbook
  Dim wsActive                    As Excel.Worksheet
  Dim sht                        As Excel.Worksheet
  Dim f                          As Object

  Set wsActive = ActiveSheet
  Set f = Application.FileDialog(3)
  f.AllowMultiSelect = False
  f.Show
    Columns("A:L").Select
    Selection.Delete Shift:=xlToLeft
  Set wb = Workbooks.Open(f.SelectedItems(1))
  Set sht = wb.Worksheets("Sheet1")
  LR = sht.UsedRange.SpecialCells(xlLastCell, xlNumbers).Row
  sht.Range("A1:L" & LR).Copy
  wsActive.Range("A1").PasteSpecial Paste:=xlPasteAll
  Application.CutCopyMode = False
  wb.Close False
    Call MacroFre
    Call SaveAs
End Sub

Please help.

Block If without End IF Error

$
0
0
Not sure why and haven't been able to figure out how to stop the "Block If without End IF" Error. I have edited my code multiple times trying to figure it what it wants me to do. I hope i can get some help thanks.

Code:

Private Sub validate()

If Sheets("Login").t1.Text = "admin" And Sheets("Login").t2.Text = "pass" Then
  Sheets("Owner").Select
 
  bOk = True
  Exit Sub
   
      With Sheets("Accounts")
        Set rng = .Range(.Cells(5, 2), .Cells(.Rows.Count, 1).End(xlUp))
        Set cl = rng.Find(User, LookIn:=xlValues)
      End With
      If cl.Offset(0, 1).Value <> Sheets("Login").t2.Text Then
        sMsg = "You have entered an incorrect Password"
        With Sheets("Login")
            Sheets("Login").t1.Value = vbNullString
            Sheets("Login").t2.Value = vbNullString
            Exit Sub
        End With
      ElseIf cl.Offset(0, 1).Value = Sheets("Login").t2.Text Then
        ilevel = cl.Offset(0, 2).Value
      ElseIf ilevel = "Level1" Then
      Sheets("Owner").Select
      ElseIf ilevel = "Level2" Then
      Sheets("Employee").Select
      End If
End Sub

ComboBoxes and ListFiillRange

$
0
0
Having to reacquaint myself with comboboxes and I find myself stumbling on basics.

My first discovery that confuses me is that it appears the only combobox that allows for autofill (search as you type) is the ActiveX version. Is this right? I had been trying to steer away from any ActiveX involvement as I noted cautions when using them on worksheets.

The next problem is proper naming for the ListFillRange. On another sheet, same workbook, I have a table. If I try to reference a column of values in that table in any method other than SheetName!A3:A250, it simply disappears. For instance, tablename[column name] or more exact MasterSchedule[Names]. What am I running into? Any pointers to a reliable, concise refresher on comboboxes?

Later I intend to feed the item selection combobox from another selection process, and I am hoping to simply use a validation drop down of three or four items, so I need to get my work with the combobox that is doing all the work down right first.

Thank-you!

Trying to open a new outlook mail window

$
0
0
So, I've been trying to work out a distribution list. So far, my research has shown me how to code to be able to send a message through outlook by typing content into a spreadsheet, but I'm trying to find code that will simply open a new message window in outlook. I don't want to send it through excel as I've found to be possible b/c outlook is asking for permission to send to each recipient on the mailing list and we have a fairly large staff here, so clicking that button 20 times to allow the email to go through is more labor intensive than just verifying who's on the distribution list and sending. Anyone who can help me with this code will be my new hero. I've scoured the earth and been unable to locate what I'm looking for.

PLEASE HELP!!!

Chart data range selection based on criteria

$
0
0
Hello Experts,

Please find the attached file Year.xlsm.
I use following code to establish source data for chart:

Code:

......... Source:=Sheets("Yearly").Range("C5:D7")
Now this is a bit complex that I want here. I want the source data range to be set based on value in Cell "H1" of the sheet "Yearly". The source range must be set to data related to past three months back from the month mentioned in Cell "H1" of the sheet "Yearly". For example if the Month value in Cell "H1" of the sheet "Yearly" is 7 then the sorce range must be set from months 5, 6 and 7, thus Range will become G5:I14.

Thank you all!
Attached Files

Need to search inside each highlighted PDF in the same folder as the Excel 2010 file

$
0
0
Hi, I'm fairly new to this site - thanks in advance for your help!

Using Excel 2010, I want to use VBA to ask the user to highlight a number of PDF's to search in the same folder as the Excel file running the VBA program.

They might select 1-10 PDF files in the folder. Then, I want to ask them for a text string to search. Then, I want to loop through each of those highlighted PDF's searching for that string/text and when found then to tell them the file name and page number, and then print that specific PDF page.

Any help you can offer for any portion of this would be greatly appreciated - thanks!!!

I've spent a couple of hours searching on the web and haven't been able to get over this hurdle yet...
I'm having issues opening the PDF files using:
Code:

Set AcroApp = CreateObject("AcroExch.App")
and
Code:

Set AcroAVDoc = CreateObject("AcroExch.AVDoc")
- am getting Run-time error 429 "ActiveX component can't create object"

Inside the VBA Editor, under Tools>References, I do haveI do have the "Adobe Acrobat 10.0 Type Library" and "Acrobat Access 3.0 Type Library" selected. I am running this on a Windows 7 PC using Adobe Reader XI, version 11.0.5.

I suspect that I can use "ActiveWorkbook.FollowHyperlink FileNameStr" in a loop, and replace the FileNameStr with the next file somehow, but do not know how to search the PDF once it is open and then to identify the page #, print the page, etc.

Thanks in advance!!!

Need to populate a multicolumn listbox using the value of a combo box

$
0
0
Hi

I have a userform with a combo box and a list box. I want the user to be able to select an item in the combo box and the list box will populate with the details based on the selection. The data is on a sheet called Reporting. I get a Type mismatch error on the loop. Cam someone let me know where I am going wrong or suggest a better way to write the code.

Thanks in advance for your time.

Code:

Private Sub cboAssetNumber_Click()
Dim Rng As Range
Dim ws As Worksheet
Dim cell As Range

crit = cboAssetNumber.Value
 
Set ws = ThisWorkbook.sheets("Reporting")
Set Rng = ws.Range("D2", ws.Range("D2").End(xlDown))
 
           
    For Each cell In Rng.Cells
    If Rng.Cells(cell, 4) = crit Then
        With Me.lstRepairs
            .AddItem cell.Value
            .List(.ListCount - 1, 1) = cell.Offset(0, 1).Value
            .List(.ListCount - 1, 2) = cell.Offset(0, 2).Value
        End With
        End If
    Next cell
       
End Sub

Transfer numbers from userform divited by a search number

$
0
0
Hello

In sheet lists I have a list of names and to the next column, I use 0ne 0f these threee options
1/3 OR 2/3 OR O(zero).
So what I need is this
When a user choose name from the combobox and then type numbers in textboxes, I d; like these numbers to transferd in data base
column M, but if number of the specific customer in Lists Sheet is 2/3, then the 2/3 of the choosen numbers should transferred rounded to the nearest biggest number.
Example: If I choose Maria, and type 30--10--15--25--40, in text boxes, then numbers
20---7--5-17--27, should transfer in database column M.

If i choose Stevens, then numbers should tranfered as ii is. No chance.


Thanks in Advance for any assistance on this.

paste to new workbook VBA

$
0
0
Hi, the below code copies data in a selected range and pastes it in values on a new selected worksheet.

Is there away it can be copied to a new workbook instead?

Code:

Sub CopyPaste()
 Dim ws As Worksheet
 For Each ws In Worksheets

 If ws.Name <> "Sheet1" Then

 ws.Application.Run "Macro1"
 End If
 Next
 End Sub

 Sub Macro1()
 Range("A2:A13").Copy
 Sheets("sheet2").Range("A10").PasteSpecial xlValues
 End Sub

Copy entire row based on 2 criteria and paste on the next blank row on a specific sheet

$
0
0
Hi,

I have searched the below codes on this forum and modified a little. It should have been perfect code for my purpose except that if there are no more data from row 3 in the source sheet ["BANK ENTRIES"] and the user (by mistake) clicks again the button to run the macro, the second header [row 2] will be moved to the other sheet ["Bank-Cleared"] and if the user clicks the button further, the first header [row 1] will be moved as well. The bad thing is that, my button is in row 1 which will be deleted and pasted to the other sheet ["Bank-Cleared"]. Kindly help.


Code:

Sub MoveMatched_Bank()
'For Move Entire Row to New Worksheet if Cell Contains Specific Text?
'Using autofilter to Copy rows that contain centain text to a sheet called Errors
Dim lr As Long
Application.ScreenUpdating = False
Range("A3").EntireRow.Insert Shift:=xlDown
lr = Sheets("BANK ENTRIES").Cells(Rows.Count, "H").End(xlUp).Row
LR1 = Sheets("Bank-Cleared").Cells(Rows.Count, "A").End(xlUp).Row + 1
    With Sheets("BANK ENTRIES").Range("H3:H" & lr)
        .AutoFilter
        .AutoFilter Field:=1, Criteria1:="Y", _
        Operator:=xlOr, Criteria2:="y"
        .SpecialCells(xlCellTypeVisible).EntireRow.Copy Destination:=Sheets("Bank-Cleared").Range("A" & LR1)
        .SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
End Sub

Detecting a PASTE event related to a UserForm TextBox.

$
0
0
I have a UserForm with a TextBox on it that allows the user to input up to 1,000 characters of notes. There are certain characters that are not allowed such as slashes, parens, ampersands, etc. I have a function that keeps these characters out (using the KeyPressed event) but, I would like to be able to detect when the user has used "paste" to populate the TextBox. The Keypressed event only fires when the user types the information in manually.

I suppose I can step through the contents of the TextBox character by character everytime the content changes, but isn't there a way to detect a "paste" event instead?

Thanks.

[SOLVED] Button to run three macros, one at a time

$
0
0
I have a sheet with three macros.

I would like to have one button that will toggle between the macros.

First push of button - macro1 runs

Push button again macro2 runs

Push again macro3 runs

Push again macro1 runs.....and so forth

Any ideas?

Thanks

Macro to go to next cell down a row

$
0
0
Hello everyone. Macro to go to next cell down a column

I need your help. I need a macro to jump to the next cell after data entry.
e.g. When data in A1 is entered, say '12345' instead of hitting enter to go to A2, macro should automatically move cursor to A2 and so on until I hit enter then the macro moves to the next sheet in the same book and repeats.

Any help out there will be greatly appreciated.

Thanks

Time empty conditional Formatting?

$
0
0
Hi, i have a box where i entered data (e.g A1), the data is then moved to a different cell, (E.G A2) and the original cell data is deleted (a1).

I would like cell a1 to turn green, or a colour, so that i know i entered text in there.

But i would only like to do this for about 5 minutes, or untill the workbook closes, whatever is possible.

But i have multiple cells where i entered (h2:h100,j2:j100)

I have found a way do sort of do this with my code, but i cannot use excel untill the alloted time is over. I would like to be able to use excel whilst doing this.

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
        With Target
            If .Count > 1 Then Exit Sub
            If Not Intersect(Range("b2:b113", "c2:c113"), .Cells) Is Nothing Then
                Application.EnableEvents = False
                If IsEmpty(.Value) Then
                    .Offset(0, 3).ClearContents
                Else
                    With .Offset(0, 3)
                        .NumberFormat = "dd/mm/yy"
                        .Value = Now
                    End With
                End If
                Application.EnableEvents = True
            End If
        End With
       
    Dim Rng As Range
    Set Rng = Range("H2:H100", "I2:I100") 'Rows(1)
   
   
    If Not Intersect(Target, Rng) Is Nothing Then
        Application.EnableEvents = False
        With Target
            If IsNumeric(.Value) Then
                .Offset(0, 2).Value = .Offset(0, 2).Value + .Value
                .ClearContents
                .Select
                .Interior.Color = 1
                Application.Wait (Now + TimeValue("0:00:10"))
                .Interior.Color = 50
               
            End If
        End With
        Application.EnableEvents = True
    End If

    End Sub

The main reason i want this is, is the destination cell will be hidden, so i will not be able to see that i have entered data or not, so i would like the cell that i entered data into, to give me some sort of notification that data has been entered within that cell within the past 10 minutes, or untill excel closes (data will only be entered in the boxes once everyone 24 hours, maybe twice)

And this is for a personal worksheet i am working on, not for work or anything, so any method that works will be greatly appreciated!!

Search worksheet for next blank cell in column B and copy data in row from another workshe

$
0
0
My head is all spins. have tried various methods but just cant get what im looking for. Would greatly appreciate if any help rendered.

I have a workbook with 2 worksheet. "Authorization" sheet is the one in which data is entered by a user, it has 2 buttons that run a macro, "Accept" and "Reject". The other worksheet is a kind of database called "Header" which has a row 1 with the headings and in column A are predefined serial numbers "P001-P008". The purpose is to maintain statistics.

What I want to do is when the user clicks the Accept button on Authorization sheet, it should search Column B range B4:B11 in Header sheet (since column A already had data which must not change), for next empty cell and then start copying the data from different cells in Authorization to the relevant columns in Header sheet as per row headings.

E.G, search Header sheet for next empty cell between column B4:b:11, select that row and copy data from Authorization sheet cell B8 to Header sheet B column in that empty row detected, copy Authorization sheet C8 to header sheet C in the same empty row detected.

I don't know if I make sense or if its any possible even. but would appreciate help as mentioned earlier.

i'm attaching the structure of the workbook and the code im working on. let me mention the codes is a jumble of several stuff that I tried but failed to get what I want. that's while you will find much of it commented. but NONE worked . please help


Code:

Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
   
    Dim cwsh As Worksheet
    Dim r As Long
    Dim c As Long
    Dim strSheetName As String
   
 
    Set ws = Sheets("Authorization")
    Set ws1 = Sheets("StaffName")
 
 
    strSheetName = ws.Range("F5")

        If Not wsExists(strSheetName) Then
            Worksheets("Header").Copy after:=Sheets("Header")
            Worksheets("Header (2)").Name = strSheetName
            Set cwsh = ActiveWorkbook.Worksheets(strSheetName)
            'cwsh.Name = strSheetName  'Add(After:=Worksheets(Worksheets.Count))
            'Worksheets("Header").Cells.Copy
            'With Worksheets(strSheetName)
            '  .Rows(1).PasteSpecial xlFormats
              '  .Rows(1).PasteSpecial xlValues
              ' .Columns(1).SpecialCells(xlBlanks).EntireRow.Delete
            'End With
            'Worksheets("Header").Rows(14).Copy Worksheets(strSheetName).Rows(14)
            'Worksheets("Header").Columns("A").Copy Worksheets(strSheetName).Columns("A")
            Application.CutCopyMode = False
            Else
            Set cwsh = ActiveWorkbook.Worksheets(strSheetName)
            End If
           
           
            For Each cell In cwsh.Range("B4:B11")
            If IsEmpty(cell) = True Then
            cwsh.Cells(r, 2) = ws.Range("B8")
           
           
            'With Worksheets(strSheetName)
            'Row = 4
            'Do While Cells(Row, 2) <> ""
            'Cells(Row, 2).Activate
            'Row = Row + 1
            'Loop
           
           
            'cwsh.Range("B4").Select
            'Do Until ActiveCell.Row = 11
            'Selection.End
           
           
            'r = cwsh.Range("B4:B11" & Rows.Count).End(xlUp).Row + 1
            'r = cwsh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            'cwsh.Cells(r, 2) = ws.Range("B8")
            'r = cwsh.Range("B11").End(xlUp).Offset(1, 0).Select
            'ActiveCell.FormulaR1C1 = ws.Range("B8")
            'r = cwsh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

Attached Files

insert password

$
0
0
Hello to all,
ask help for a curiosity.
I have a workbook that appears at startup with a notice of welcome userfom.
This userform can close immediately with the close button or wait until the end of the scrolling text.
You can change this?:
----------------------------------------------------------------------------------------------------------------------
instead of the close button to add a box in which to enter a password (already established in VBA) and if I enter the exact file you start otherwise closes.
--------------------------------------------------------------------------------------------------------------------
Thanks in advance.
I hope I explained.
I attach the sample file.
In advance thank you.
max_max

==========================================================================================

Ciao a tutti,
chiedo un aiuto per una curiosità.
Ho un workbook che all'avvio compare un avviso di benvenuto con userfom.
Questa userform posso chiuderla subito con il pulsante chiudi o aspettare la fine del testo scorrevole.
è possibile questa modifica?:
----------------------------------------------------------------------------------------------------------------------
al posto del pulsante chiudi aggiungere una casella in cui inserire una password (già stabilita in VBA) e se la inserisco esattamente il file si avvia altrimenti si chiude.
--------------------------------------------------------------------------------------------------------------------
Grazie in anticipo.
Spero di essermi spiegato.
Allego il file di esempio.
In anticipo ringrazio.
max_max

prova password.xls

color cells based on value (#N/A causes error)

$
0
0
Hi im trying to color cells based on value but #N/A causes an error. How do I get round this

Attached is a snapshot of a sheet that has thousands of lines. Ideally id like the #N\A to stay as it does mean something to me.
Attached Files

Adapting VBA from Word to work in Excel

$
0
0
Hello, I am a total novice when it comes to VBA. I have been using a macro in Word created from pieces all over the internet (credit to a user named matt198992 for recursion script). The code prompts a user for folder, then runs a macro called Publish as PDF to all word files in the folders/subfolders.

I want to adapt the code in Excel, but im having trouble. Error on the line "Workbooks.Open Filename:="Path & DirN". All help would be truly appreciated. Thank you.



Code:

Sub BatchExceltoPDF()
   
    Dim strFolder As String
 Set fd = Application.FileDialog(msoFileDialogFolderPicker)
 With fd
    .Title = "Select the folder to Convert."
    If .Show = -1 Then
        strFolder = .SelectedItems(1) & "\"
       
        Application.Run "personal.xls!Recurrer", (strFolder)
       
    Else
        MsgBox "You did not select a folder"
        strFolder = ""
    End If
 End With

    End Sub

    Sub Recurrer(Path As String)

        Dim DirN        As String
        Dim DirList()  As String
        Dim ndx        As Long
        Dim pos        As Long ' added
     
        ' Add vbSystem, vbHidden, etc., if you want such files
        DirN = Dir(Path, vbDirectory)
     
        Do While DirN <> ""
            If DirN = "." Or DirN = ".." Then
                ' Ignore
            Else
                If (GetAttr(Path & DirN) And vbDirectory) = vbDirectory Then
                    If (Not DirList) = True Then
                        ReDim DirList(0 To 0)
                    Else
                        ReDim Preserve DirList(0 To UBound(DirList) + 1)
                    End If
                    DirList(UBound(DirList)) = DirN
                Else
                    ' DirN has a file name
                    pos = InStrRev(DirN, ".")
                    If pos > 0 Then
                        If InStr("xls xlsx xlsm", LCase(Right$(DirN, Len(DirN) - pos))) Then
                            ' The file is a xls, xlsx or xlsm
                            ' Do whatever with it
                           
                       
    Workbooks.Open Filename:="Path & DirN"
                       
    Application.Run "personal.xls!PublishasPDF"
   
    ActiveWorkbook.Close


                       
                       
                        End If
                    End If
                End If
            End If
         
            DirN = Dir ' This just gets the next name before going round again
         
        Loop
     
        ' Now process the saved subdirectories
        If (Not DirList) = True Then
        Else
            For ndx = 0 To UBound(DirList)
                Recurrer Path & DirList(ndx) & Application.PathSeparator
            Next
        End If
     
    End Sub

Sub PublishasPDF()
'
' PublishasPDF Macro
Dim strName As String


With ActiveWorkbook
  strName = .FullName
  strName = Left(strName, InStrRev(strName, ".")) & "pdf"
 ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strName, Quality:=xlQualityStandard, _
        IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
       
    End With
   
  End Sub

Viewing all 50013 articles
Browse latest View live