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

Help with VBA loop

$
0
0
Hi

Please can anyone help me with some code. I'm trying to get the code to loop through all the completed cells.
The code below copies certain cells into bookmarks on a word templete then re-saves. I can only get it to look at the first row and not loop through them all.

What have i missed out?

Formula:
Private Sub CommandButton1_Click()
Dim objWord As Object, i As Integer
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
i = 2

objWord.Documents.Open "C:Documents\Letter template.docx" ' change as required
With objWord.ActiveDocument
.Bookmarks("Text1").Range.Text = ws.Cells(i, 1).Value
.Bookmarks("Text2").Range.Text = ws.Cells(i, 1).Value
.Bookmarks("Text3").Range.Text = ws.Cells(i, 2).Value
.Bookmarks("Text4").Range.Text = ws.Cells(i, 3).Value
.Bookmarks("Text5").Range.Text = ws.Cells(i, 4).Value
.Bookmarks("Text6").Range.Text = ws.Cells(i, 5).Value
End With
objWord.ActiveDocument.SaveAs2 Filename:="C:Documents\" & "Letter_" & (i) & ".docx"
'objWord.ActiveDocument.PrintOut
objWord.ActiveDocument.Close
i = i + 1
If Cells(i, 2) < 1 Then GoTo stopPrinting 'ends the counting loop stops printing and goes to end routine

MsgBox "Generation of letters complete." & vbCrLf & "A total of" & Str(i - 2) & " letters were created"
stopPrinting: objWord.Quit True
End Sub

i need to copy the dates (from date to date) if i have specific number in the row

$
0
0
Hi friends
happy to write to you for the first time

could you please help me urgently with the below excel sheet

i have a full 2 month dates in row A and i have a numbers at the rest of rows (b,c,d, etc) and i need to write in column B and c the dates from - to ( 07.04.16 to 11.04.16) if i have number 3 in the other rows

name----from date---- to date-----07.04.16----08.04.16----09.04.16----10.04.16----11.04.16----12.04.16----13.04.16
jac------------------------------------3-----------3-----------3------------3----------2-----------5-----------7
ali-------------------------------------5-----------3-----------3------------3----------2-----------5-----------7
joe------------------------------------3-----------3-----------5------------3----------3-----------3-----------3

results should be

name----from date---- to date-----07.04.16----08.04.16----09.04.16----10.04.16----11.04.16----12.04.16----13.04.16
jac------07.04.16-----10.04.16---------3-----------3-----------3------------3----------2-----------5-----------7
ali-------08.04.16-----10.04.16---------5-----------3-----------3------------3----------2-----------5-----------7
joe-------------------------3-----------3-----------5------------3----------3-----------3-----------3

in the last row i need to have 4 columns (can i do this or not)




thanks in advance for your help

Adding named ranges in variable position

$
0
0
Hi all,

I will try to explain it as good as possible, as it is hard to add my file due company information.

I use Private Sub worksheet_Change (ByVal Target as Range)

my range for changes:
Code:

KeyCells = Range(Range("A11").End(xlDown).Offset(0, 9), "J12")
The cell/range that needs a dropdown list with a named range is called [SELECT DEALER]. This can't a fixed field as the range of keycells can be 25 items as well as 50 items.

Whenever a change is made in KeyCells, it needs to change the dropdownlist in [SELECT DEALER]. The dealer are the characters until the first space of column A (of the corresponding target.address) and is the same name as the named range.

So if for example i pick and change J15 and A15 = "Computer Supplies", the cell with [SELECT DEALER] would need to have the dropdownlist with named range =Computer.


Can anyone help me with this?
I'm sorry if i'm unclear, if more information is needed i will try to do my best to explain properly.

thanks so much!

Split Excel Workbook (multiple sheets) by tab names and merge into several work books

$
0
0
Hi, my first time posting as I've usually found what I need by googling and got it working but I am a complete novice.

What I'd like to do if anyone could help please is Split a workbook that has many tabs and then merge those tabs into several workbooks according to their groupings.

So I have a spreadsheet that has a datasheet per sales rep and then associated pivot tables with each of the datasheets, rep John has Datasheet John, Performance Pivot, Targets Pivot and so on and the same for every rep. These need to be shared with each rep into their folders on a box account. So I want to split the workbook by tabs and then bring the tabs together into multiple workbooks named after each rep. So that they can then be distributed to them via box. Is this possible? I have found how to split the sheet into individual tabs, how to move particular sheets to certain folders (via a list created in excel) but cannot find anything on this.

Any help would be appreciated.

Thanks a mil
Marian

VBA to get sheet names from closed workbooks

$
0
0
Hi all and thanks in advance for the help,

I have workbooks with name "WorkBook_1.xlsb", "WorkBook_2.xlsb", ..........,"WorkBook_20.xlsb", each of them having the common sheet names "PList", "Sheet1", "Sheet2","Sheet3","Sheet4"..., and then the data sheet after.

How to get the data sheet names of the these closed workbooks and List them to "Workbook_00.xlsb" to "Sheet1" Column("A"),
Attached Files

[SOLVED] Macro to Cut out a row and move to new sheet

$
0
0
I'm in need of a macro that will cut a row out of a worksheet based on a criteria in a specific column, and add to a new sheet ( need to keep history, but dont want it on the main report), I've attached a sample.
THANK YOU in advance, I'm in desperate need of this and can't figure it out.
Attached Files

Listbox multiple issues

$
0
0
Hi all,

First post here, but as I'm not entirely new to Excel and VBA (doing selfstudy for a few weeks in VBA and 10+ years of Excel experience in general), I'm hoping to return the service later on by helping others

So I'm creating an invoicing tool from scratch and I'm stuck with a certain listbox.
I'll try to explain as much as I can what I want this listbox to do.

So first, I generate certain invoice data in a userform (invoice date, subject, client, etc...). This data is written to sheet1 (facturatieoverzicht).
In this sheet1, I created a dynamic range :
Code:
=OFFSET(Facturatieoverzicht!$A$2;0;0;COUNTA(Facturatieoverzicht!$A:$A);COUNTA(Facturatieoverzicht!$10:$10))
Why do I only select 10 columns? Because I want the listbox to show only 5 columns (so the columnwidth of the other 5 is 0).


I have the listbox in sheet3 (factuurtemplate), which has the invoice template on the left and the listbox on the right.
I've linked sheet1 to this listbox with the ListFillRange property. The listbox data is: sequential number, client, invoice number, invoice date, amount.
Now, all invoices are showing up in this list. Based on the user selection, I've written a code to perform a vlookup and fill certain cells in the template based on the selected value.
once the invoice template is filled in with the data selected, the user is able to push the print or email button etc...

Here is the code that I execute as soon as a different item is selected in the list:

Code:

Sub listfacturen_change()



If listFacturen.List(listFacturen.ListIndex, 0) = "" Then      This is to make sure no empty row is selected as this will return an runtime error. Should not be required if my dynamic range works properly...


MsgBox "Please select an invoice to display"


Else


Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$g$5") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 0), Worksheets("facturatieoverzicht").Range("$a$2:$z$4000"), 5, 0)
Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$g$6") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 0), Worksheets("facturatieoverzicht").Range("$a$2:$z$4000"), 4, 0)
Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$g$7") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 0), Worksheets("facturatieoverzicht").Range("$a$2:$z$4000"), 6, 0)
Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$D$12") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 0), Worksheets("facturatieoverzicht").Range("$a$2:$z$4000"), 3, 0)


Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$D$20") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 0), Worksheets("facturatieoverzicht").Range("$a$2:$z$4000"), 14, 0)
Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$G$20") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 0), Worksheets("facturatieoverzicht").Range("$a$2:$z$4000"), 15, 0)
Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$D$21") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 0), Worksheets("facturatieoverzicht").Range("$a$2:$z$4000"), 16, 0)
Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$G$21") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 0), Worksheets("facturatieoverzicht").Range("$a$2:$z$4000"), 17, 0)
Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$D$22") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 0), Worksheets("facturatieoverzicht").Range("$a$2:$z$4000"), 18, 0)
Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$G$22") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 0), Worksheets("facturatieoverzicht").Range("$a$2:$z$4000"), 19, 0)
Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$D$23") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 0), Worksheets("facturatieoverzicht").Range("$a$2:$z$4000"), 20, 0)
Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$G$23") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 0), Worksheets("facturatieoverzicht").Range("$a$2:$z$4000"), 21, 0)
Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$D$24") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 0), Worksheets("facturatieoverzicht").Range("$a$2:$z$4000"), 22, 0)
Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$G$24") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 0), Worksheets("facturatieoverzicht").Range("$a$2:$z$4000"), 23, 0)


Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$G$33") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 0), Worksheets("facturatieoverzicht").Range("$a$2:$z$4000"), 7, 0)
Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$G$34") = -Application.VLookup(listFacturen.List(listFacturen.ListIndex, 0), Worksheets("facturatieoverzicht").Range("$a$2:$z$4000"), 8, 0)
Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$G$35") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 0), Worksheets("facturatieoverzicht").Range("$a$2:$z$4000"), 9, 0)
Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$G$36") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 0), Worksheets("facturatieoverzicht").Range("$a$2:$z$4000"), 10, 0)
Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$G$37") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 0), Worksheets("facturatieoverzicht").Range("$a$2:$z$4000"), 11, 0)
Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$G$38") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 0), Worksheets("facturatieoverzicht").Range("$a$2:$z$4000"), 12, 0)
Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$G$39") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 0), Worksheets("facturatieoverzicht").Range("$a$2:$z$4000"), 13, 0)


Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$D$13") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 2), Worksheets("klantendatabase").Range("$a$2:$z$4000"), 5, 0) & " " & Application.VLookup(listFacturen.List(listFacturen.ListIndex, 2), Worksheets("klantendatabase").Range("$a$2:$z$4000"), 6, 0)
Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$D$14") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 2), Worksheets("klantendatabase").Range("$a$2:$z$4000"), 7, 0) & " " & Application.VLookup(listFacturen.List(listFacturen.ListIndex, 2), Worksheets("klantendatabase").Range("$a$2:$z$4000"), 8, 0)
Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$D$13") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 2), Worksheets("klantendatabase").Range("$a$2:$z$4000"), 5, 0) & " " & Application.VLookup(listFacturen.List(listFacturen.ListIndex, 2), Worksheets("klantendatabase").Range("$a$2:$z$4000"), 6, 0)
Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$D$15") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 2), Worksheets("klantendatabase").Range("$a$2:$z$4000"), 12, 0)
Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$D$16") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 2), Worksheets("klantendatabase").Range("$a$2:$z$4000"), 11, 0)
Workbooks("Facturatie Latest.xlsm").Worksheets("factuurtemplate").Range("$D$17") = Application.VLookup(listFacturen.List(listFacturen.ListIndex, 2), Worksheets("klantendatabase").Range("$a$2:$z$4000"), 10, 0)


End If


End Sub

So just to be clear: this code works as I expected it to work, but I have some additional questions to finetune it:

1) If I open another workbook with macro's in it, it will give me a runtime error on this code instantly. I was able to fix this by adding a code to activate the workbook 'facturatie latest' first. However, as soon as I added a tab to this workbook (the invoice workbook), it would show another error in this code.
So any advice on how to debug this code would be great... is there something like 'if the code returns an error, don't do anything and don't pop up with the error message'?

2) I would like to add a searchbox (textbox) above the listbox. If I type any value that exists in one of the 5 columns, it should filter those rows out.
I know that there are many examples on the internet (and here), but none of them seem to work in my case. I'm guessing it's related to the fact that I have code that executes as soon as the listbox changes? Is there a workaround, without losing the 'click item => template is filled' functionality?

3) So there's also a problem with my dynamic range. It shows all rows (1-4000) that I filled with formula's. Column A is the sequential numbering of this code:
Code:
=IF(C5="";"";A4+1)
(column C is the client field, which is automatically filled when the user creates an invoice in my userform). So column A returns an empty cell when there is no client filled in.
Of course, I just want it to show the filled in rows instead of all 4000 (I just chose 4000 to limit the file size). I've created dynamic ranges before and those worked perfectly. However this one doesn't seem to be working... Should I base the code on a column without formulas instead, for example C?

4) Currently, my listbox is set up as multiselectSingle. However, I want it to improve by adding the following functionality:
If the user selects more than 1 invoice (let's say the last 10 invoices), a msgbox should pop up and ask to confirm if they want to save them all as pdf or save and send each invoice seperately to the emailadress in the invoice template (cell D16).
I suppose I should work with a loop function and execute code if the item is selected.
I'm just not sure how I should implement this in my code without adding more chance of errors...

I really have to dig into listboxes further, so I'm not 100% sure that the above is possible to be combined in 1 listbox.
If there is anyone able to help me out, that would be awesome!

Thanks a lot in advance!!!

Code for finding most recent email with " " subject when multiple exist

$
0
0
Below is the code i am using to find an email with the subject "raw sales log" in my inbox and copy and paste it into another worksheet. It works fine, but when i have more than one email with the same subject, it gives me an error. I am looking to add some code that will look for the subject i have specified, but only find the most recent one, and ignore the others



Code:

Option Explicit

Sub REFRESH()
    Dim olApp As Outlook.Application
    Dim olNS As Outlook.Namespace
    Dim olInBox As Outlook.MAPIFolder
    Dim olMoveToFolder As Outlook.MAPIFolder
    Dim olItems As Outlook.Items
    Dim olAtt As Outlook.Attachment
    Dim strSaveToFolder As String
    Dim strPathAndFilename As String
    Dim Ans As Long
    Dim i As Long
    Dim LoginName As String
    LoginName = Environ("username")

   
    strSaveToFolder = "C:\Users\" & LoginName & "\Desktop\"  'change the path accordingly
   
    If Right(strSaveToFolder, 1) <> "\" Then strSaveToFolder = strSaveToFolder & "\"
   
    Set olApp = CreateObject("Outlook.Application")
   
    Set olNS = olApp.GetNamespace("MAPI")
    Set olInBox = olNS.GetDefaultFolder(olFolderInbox)
    Set olMoveToFolder = olInBox.Folders(olFolderDeletedItems) 'change the name of the subfolder accordingly
    Set olItems = olInBox.Items.Restrict("[Subject] = 'raw sales log'")
   
    For i = olItems.Count To 1 Step -1
        If olItems(i).Attachments.Count > 0 Then
            For Each olAtt In olItems(i).Attachments
                strPathAndFilename = strSaveToFolder & olAtt.Filename
                If Len(Dir(strPathAndFilename, vbNormal)) = 0 Then
                    olAtt.SaveAsFile strPathAndFilename
                    olItems(i).Save
                Else
                    Ans = MsgBox(olAtt.Filename & " already exists.  Overwrite file?", vbQuestion + vbYesNo)
                    If Ans = vbYes Then
                        olAtt.SaveAsFile strPathAndFilename
                        olItems(i).Save
                    End If
                End If
            Next olAtt
            olItems(i).Move olMoveToFolder
        End If
    Next i
   
    Set olApp = Nothing
    Set olNS = Nothing
    Set olInBox = Nothing
    Set olMoveToFolder = Nothing
    Set olItems = Nothing
    Set olAtt = Nothing
   

    Sheets("COPY RAW DATA HERE").Select
    Cells.Select
    Selection.ClearContents
    Workbooks.Open "c:\users\" & LoginName & "\desktop\rawsaleslog.csv"
    Cells.Select
    Selection.Copy
    Windows("ny sales calculator ultimate.xlsm").Activate
    Cells.Select
    ActiveSheet.Paste
    Range("A1").Select
    Sheets("PIVOT TABLE").Select


Application.ScreenUpdating = False
    Sheets("COPY RAW DATA HERE").Select
    Range("A1").Select
    Columns("E:E").Select
    Selection.Replace What:="5027", Replacement:="5525", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="5605", Replacement:="5600", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="5086", Replacement:="5101", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("F4").Select
    Sheets("PIVOT TABLE").Select
    Range("A1").Select
    ActiveSheet.PivotTables("PivotTable1").PivotCache.REFRESH
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Type").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Type").CurrentPage = "SLD"
    ActiveSheet.PivotTables("PivotTable1").PivotFields("branch").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields("branch").CurrentPage = "all"
    ActiveSheet.PivotTables("PivotTable1").PivotFields("emp type").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields("emp type").CurrentPage = "all"
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Selling Bunit").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Selling Bunit").CurrentPage = "ALL"
    ActiveSheet.PivotTables("PivotTable1").PivotFields("lead src").ClearAllFilters
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Lead Src").CurrentPage = _
        "(All)"
   
    ActiveSheet.PivotTables("PivotTable1").PivotFields("branch").CurrentPage = "BRANCH"
    ActiveSheet.PivotTables("PivotTable1").PivotFields("emp type").CurrentPage = "SALES REPS"
   
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Lead Src")
        .PivotItems("0").Visible = False
    End With
    Range("A1").Select

Application.ScreenUpdating = True

End Sub

Sub screen_update()

Application.ScreenUpdating = True


End Sub


Formula to Remain Constant after cut/paste

$
0
0
I have a spreadsheet that has 3 tabs. On the 2nd tab, each cell is a formula pulling data from tab 1. When I cut/paste a line of data from tab 1 to tab 3, I need the cells in tab 2 to go blank and wait on new data to be entered in the empty cells in tab 1 that were cleared by the cut/paste instead of updating the formula to follow the data to tab 3. I hope this makes sense. I attached a spreadsheet that gives an example. Thanks.
Attached Files

Renaming Sheet if it already exists - again

$
0
0
I have seen other posts on this subject, and have tried to emulate the solutions - however the code below keeps falling over if it comes across a name that already exists in the workbook; please can someone tell me what/where I am going wrong?

Sub SplitReports(ByVal WkBkS As String, SNameCell As String, RNameCell As String)

Dim WkBk As Workbook

Set WkBk = Workbooks(WkBkS & ".xlsx")
WkBk.Activate

For Each WkSht In WkBk.Worksheets
SName = Left(WkSht.Range(SNameCell).Value, 31)
If SName = "Closed Report" Then
Cells.Replace WHAT:="Limited", REPLACEMENT:="Ltd", LookAt:=xlWhole, SearchOrder:=xlByRoWkSht, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
SName = Left(WkSht.Range("A2").Value, 31)
End If

Call DoesNameExist(ShName:=SName)

If Chk Then
WkSht.Name = Left(SName, 30) & "_"
Else
WkSht.Name = SName
End If

If RNameCell = "Closed Report" Then
RName = RNameCell
Else
RName = WkSht.Range(RNameCell)
End If
FPath = Application.ActiveWorkbook.Path
WhatDay = Day(Date)
If WhatDay < 5 Then
FDate = Format(DateAdd("m", -1, Date), "yyyy-mm")
Else
FDate = Format(DateAdd("m", 0, Date), "yyyy-mm")
End If
FName = FPath & "/" & WkSht.Name & " - " & RName & " - " & FDate & ".xlsx"
WkSht.Copy


Set WkBkNew = ActiveWorkbook
WkBkNew.SaveAs FName
WkBkNew.Close

Next WkSht

WkBk.Close Savechanges = False
End Sub
Function DoesNameExist(ShName As String)
Dim Chk As Boolean
Chk = False
For Each WkSht In Worksheets
If ShName = WkSht.Name Then
Chk = True
Exit Function
End If
Next WkSht
End Function

How do edit a Specific Shape?

$
0
0
I have workbook that includes a Shape with a hyperlink to 'Return to Index' of the workbook. That shape is called "Rounded Rectangle 2"

Is there to edit the that shape name in VBA? I would like to change the actual shape to perhaps to smaller size (and perhaps to an oval).

I think Once I understand that, I can then loop all the worksheets and update that shape through out the entire workbook.

vba to copy workbook without macros or code

$
0
0
Hi can anyone help please I need a vba macro that will copy a workbook with out the macros and code so just the sheets and information on the sheets and name the new workbook using cell A1 on the control sheet for example "data" in cell A1 so the new workbook is called data

Can twitter hyperlinks be reprsented as "Twitter" text like in html

$
0
0
I have a column of twitter Hyperlinks, is it possible to (as in html) turn them into text that are links so that each hyperlink is instead the word Twitter

https://twitter.com/abc becomes the link Twitter

Thanks

macro to print hidden cell ranges

$
0
0
I have spreadsheet in that I want to print hidden cell ranges which I have already selected for print area
Thanks in advance to help

Compile error referencing checkbox in another sheet

$
0
0
Hi everyone (Ok, it's my first post...)

I have some code behind one sheet (sheet1) which includes a routine to hide/unhide some rows in another sheet (sheet2) in the same workbook and enable/disable some CheckBoxes. The original version (which worked) included a sheet1.select statement and then used statements such as sheets("sheet2").rows(x:y).entirerow.hidden = True/False to hide the x:y rows. Sheet2 also has a couple of checkboxes eg checkbox1 which it enabled/disabled using sheets("sheet2").checkbox1.enabled = True.

In attempting to tidy this up (more fool me) I have sought to avoid the 'select' statement (as I don't need to change any values in sheet2, just hide/enable as above) and have also set a worksheet variable in place of sheets("sheet2")

So I start with something like..

Code:

Dim ws as worksheet
set ws = sheets("sheet2")

I then have statements like

Code:

if....
ws.rows("23:35").entirerow.hidden = true
ws.checkbox1.enabled = true
...

When I try and run this I get a compile error - 'Method of Data member not found' referring to the ws.checkbox1.enabled = true line. I did think this might be connected to the .exd file issue but having deleted these it makes no difference.

if I comment out this offending line and replace it with sheets("sheet2").checkbox1.enabled = true, then all is well.

Am I missing something? Could it be that whilst hiding lines in another sheet can be done without a select statement (ie without making Sheet2 the active sheet) this does not apply to checkboxes? I've tried adding a ws.select or even a sheets("sheet2").select statement but I still get the same compile error.

Any ideas...?

Find and replace string if value find in column

$
0
0
Hi all,

I have two sheets (Sheet1 and Sheet2).

I would like a VBA to look at values in column A in Sheet2 and if found it replace with any other text or remove this value in column A in Sheet1.

So as a result I would have White, Black, Orange, White, without a, b, c, d, as these values are in Sheet2.


Sheet1
Column A
a white
b black
d white
c orange


Sheet2
Column A
a
b
d
c




Thanks a lot!

Disabling Save and Save As

$
0
0
I want to prevent users of my workbook from overwriting the template version.

I have already written a piece of code that on clicking a control button in the workbook renames the book and saves it in another file location, another then is used to save under the new name if changes are made.

What I want to do is disable the save and save as options in the file menu so that it stops users making changes and saving without using the control button.

I have found the code below and put it into my active worksheet code window but it doesn't seem to work. I have also tried adding a line to launch a message box just to check that is was running on startup and it wasn't. I'm looking for any suggestions for either the reason why this code isn't working or any better ideas.

I'm working in Excel 2013.

Code:

Private Sub Workbook_Open()
    Application.CommandBars("Worksheet Menu Bar").Controls("File").Controls("Save As...").Enabled = False
    Application.CommandBars("Worksheet Menu Bar").Controls("File").Controls("Save").Enabled = False
End Sub

Any and all help appreciated.

Ed

Macro not working when button pressed

$
0
0
Hey all,

I've got a weird problem. The code I'm trying to trigger via a form control button does not work... The code works fine when I'm in the VBE and hit F5 to run the sub, it does the job perfectly... The button is, of course, assigned to the right sub, I've checked that twice. Macro settings are all enabled, including trusted access to VBA object model... What am I missing?

VBA Sort Custom Order

$
0
0
Trying to sort ALL data automatically...sort if something is entered in Column B or C...headers in row 1...first sort based upon Column C (dates) in descending order. That all seems to be working.

What seems to not be working is the fact that I want it also to sort based upon values in Column B; after it sorts based upon Column C. The values in Column B is either 1, 2, or 3. But, I want the sort order to be "2, 1, 3".

HELP!

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("B:C")) Is Nothing Then
Range("C1").Sort Key1:=Range("C2"), Order1:=xlDescending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
Key2:=Range("B2"), Order2:=xlDescending, Header:=xlYes, OrderCustom:="2, 1, 3", MatchCase:=False, Orientation:=xlTopToBottom
End If
End Sub

Replace All Formulas with VBA Calculated Values

$
0
0
I have a workbook that has a ton of formulas in it, which if shown in full would encompass well over 10,000 rows by 1,000 columns.
It's gotten to the point that I can no longer easily manage it or rather, Excel can no longer easily manage it due to memory constraints (on 32bit version).

The file size also balloons out of control with all of the formulas embedded in it.

My theory is if I could possibly replace the formulas with VBA code, so that it would "handle" the calculations, that the workbook would become a lot more manageable -- i.e., so that I don't have a workbook with 10 million formulas in it, but rather just the results of those calculations in each respective cell.

I've attached a sample workbook containing a snippet of data points and formulas.
It's meant to calculate distances from Points A to Points B, and then identify the 10 closest distance-based matches across the two groups.

There is a "green" section of data points and formulas that's at the top of the sheet that will always cut-off at Row 25, but may extend up to 1,000 columns to the right.
There is a "yellow" section below it consisting of other data points and formulas that will always start at row 27, but may extend down to row 10,000. And as with the above, may also need to calculate formulas up to 1,000 columns to the right.

Again, not sure how I would go about stripping out the formulas in these cells and have a VBA based solution instead, but I have a feeling that may be the ticket.
I would be immensely appreciative if anyone can take a stab at this!

Thanks in advance!
Attached Files
Viewing all 50061 articles
Browse latest View live