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

Hide/Unhide rows with an object

April 6, 2020, 1:56 am
$
0
0
Hi Guys,

Hopefully someone can help.

I'm trying to crease a macro to an object which will hide and unhide set rows. I can get a button to do this, but would much prefer to have an image, which is a down arrow that hides several rows below it.

It's used to hide details rows under header rows for finance purposes. For example smaller accounts within a large totalling account. My code for the toggle button works and looks as below, but can't seem to adjust it for an object:

Quote:
Private Sub ToggleButton1()
If ToggleButton1 Then
Rows("12:15").EntireRow.Hidden = True
Else
Rows("12:15").EntireRow.Hidden = False
End If
End Sub
Any help is much appreciated.
↧
Search

DateTimePicker - replace day/month

April 6, 2020, 2:53 am
$
0
0
Hi all,

I saw problem with DateTimePicker, when trying set in cell D1 what is in lined cell(A1) with DateTimePicker. If date is lower than 13 day of month it's replacing day with month. If date is above 12 day of month, everything is ok. Is there somewhere an option to change this?

If I enter in edit mode and exit, then is ok.
Attached Files
↧
↧

xlTotalsCalculationSum

April 6, 2020, 3:23 am
$
0
0
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns("2019-032"). _
TotalsCalculation = xlTotalsCalculationSum





Hi there

below is my macrofrom a sheet where i import data from mysql database. the field names are not always the same and keeps changing. thus above example will not help me.



I need something like to make the calculation - show totals auto sum for column c.



ActiveSheet.ListObjects("$C").ListColumns("$C"). _
TotalsCalculation = xlTotalsCalculationSum


Code:
Sub Accounts_macro()
'
' Accounts_macro Macro
'


'
Columns("C:CE").Select
Selection.Delete Shift:=xlToLeft
Range("B4").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Columns("E:E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E4").Select
ActiveCell.FormulaR1C1 = "=R[-2]C[-1]-R[-2]C[-2]"
Range("F4").Select
Columns("F:F").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("F4").Select
ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-2]"
Range("E4").Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
Columns("H:H").Select
Columns("I:I").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("I4").Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
Columns("J:J").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("J4").Select
ActiveCell.FormulaR1C1 = "(h4-g4)/h4"
Range("J4").Select
ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-2]"
Range("J5").Select
Columns("J:J").ColumnWidth = 8.86
Columns("M:M").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("M4").Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
Range("N4").Select
ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-2]"
Range("N5").Select
ActiveWindow.SmallScroll ToRight:=1
Columns("P:P").EntireColumn.AutoFit
Range("N5").Select
Selection.AutoFill Destination:=Range("N4:N5"), Type:=xlFillDefault
Range("N4:N5").Select
Columns("N:N").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("N4").Select
ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-2]"
Columns("Q:Q").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("Q4").Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
Columns("R:R").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("R4").Select
ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-2]"
Range("R5").Select
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 17
Columns("U:U").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("U4").Select
Columns("T:T").EntireColumn.AutoFit
Columns("S:S").EntireColumn.AutoFit
Range("U4").Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
Range("V4").Select
ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-2]"
Columns("Y:Y").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("Y4").Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
Columns("Z:Z").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("Z4").Select
ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-2]"
Columns("AC:AC").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AC4").Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
Columns("AD:AD").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AD4").Select
ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-2]"
Range("AD5").Select
ActiveWindow.SmallScroll ToRight:=6
Columns("AG:AG").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AG4").Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
Range("AH4").Select
Columns("AH:AH").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AH4").Select
ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-2]"
Columns("AK:AK").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AK4").Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
Columns("AL:AL").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AL4").Select
ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-2]"
Range("AL5").Select
ActiveWindow.SmallScroll ToRight:=7
Columns("AO:AO").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AO4").Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
Columns("AP:AP").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AP4").Select
ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-3]"
Columns("AS:AS").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AS4").Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
Columns("AT:AT").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AT4").Select
ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-2]"
Range("AT5").Select
ActiveWindow.SmallScroll ToRight:=6
Range("Table_pastel_12_cust_rank[[#Headers],[2019-02]]").Select
   
Range("AV5").Select
ActiveWindow.SmallScroll ToRight:=7
Columns("Aw:Aw").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("Aw4").Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
Columns("Ax:Ax").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("Ax4").Select
ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-3]"
Range("AY4").Select
ActiveCell.FormulaR1C1 = _
"=RC[-48]+RC[-44]+RC[-40]+RC[-36]+RC[-32]+RC[-28]+RC[-24]+RC[-20]+RC[-16]+RC[-12]+RC[-8]+RC[-4]"
Range("AZ4").Select
ActiveCell.FormulaR1C1 = _
"=RC[-48]+RC[-40]+RC[-36]+RC[-32]+RC[-28]+RC[-24]+RC[-20]+RC[-16]+RC[-12]+RC[-8]+RC[-4]"


   
 
   
Range("Table_pastel_12_cust_rank[[#Totals],[2019-033]]").Select
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 31
ActiveWindow.ScrollColumn = 39
ActiveWindow.ScrollColumn = 43
ActiveWindow.ScrollColumn = 52
ActiveWindow.ScrollColumn = 54
ActiveWindow.ScrollColumn = 57
ActiveWindow.ScrollColumn = 71
ActiveWindow.ScrollColumn = 73
ActiveWindow.ScrollColumn = 72
ActiveWindow.ScrollColumn = 70
ActiveWindow.ScrollColumn = 68
ActiveWindow.ScrollColumn = 65
ActiveWindow.ScrollColumn = 56
ActiveWindow.ScrollColumn = 54
ActiveWindow.ScrollColumn = 53
ActiveWindow.ScrollColumn = 49
ActiveWindow.ScrollColumn = 48
ActiveWindow.ScrollColumn = 47
ActiveWindow.ScrollColumn = 45
ActiveWindow.ScrollColumn = 44
ActiveWindow.ScrollColumn = 43
ActiveWindow.ScrollColumn = 42
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 42
     
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ShowTotals = False
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ShowTotals = True
           
End Sub
↧

VBA: POST Request to API to upload pdf

April 6, 2020, 4:07 am
$
0
0
Hi,

I need to make a POST Request to upload a pdf to an API. Has anyone done this before and can help? It is easy to make this request using the Postman software, unfortunately I don't know the syntax to do this in Excel. I have already used Excel to send a POST request to log in to the website however from what I've read by googling, the syntax to upload a file is different. The Postman HTML Code is below.

Chris

POST /api/document/process?File
=C:\Users\chris\Google Drive\Programming\Excel\CognitivPlus\PDF_Document.pdf
&= HTTP/1.1
Host: api.mywebsite.com
Content-Type: multipart/form-data; boundary=----WebKitFormBoundary7MA4YWxkTrZu0gW
Authorization: Bearer eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJfaWQiOiI1ZTY5ZjFjMTNmMzA4NDAwMTg1ZTBmYjIiLCJpYXQiOjE1ODYxMTcwOTYsImV4cCI6MTU4NjEzNTA5Nn0.z1xxy7qpxwSdmeCj2h5Qu2gpcoS3CyG6dIAKZn0VL3Y

----WebKitFormBoundary7MA4YWxkTrZu0gW
Content-Disposition: form-data; name=""; filename="/C:/Users/chris/Google Drive/Programming/Excel/CognitivPlus/Eurocastle_prospectus_Extract.pdf"
Content-Type: application/pdf

(data)
----WebKitFormBoundary7MA4YWxkTrZu0gW
↧

VBA: Auto populate new list of cells from a changing cell value

April 6, 2020, 4:40 am
$
0
0
I have a cell value (cell A1) that changes value based on multiple calculations every time I refresh the workbook (using F9).

I would like to list every result from A1 in a new list in a separate workbook so that I have a record of all the results everytime I press F9.

Anyone know the formula or code needed for this?
↧
↧

Excel setting page - Heading View OFF and CSF1

April 6, 2020, 5:38 am
$
0
0
When I open the excel file , I want :

Headings - View - OFF
Gridlines - View - OFF
Crtl - Shift - F1 - ON
↧

Please help with calculation on last line

April 6, 2020, 5:38 am
$
0
0
I need help with calculation on last line, bit it must also recalculate with filters


Below is my code. it auto calculates and works out everything 100% i just have no clue how to get my total as aa calculated field that auto calculates when filter is added.

I need "F = (D-C)/D " on the last entry line.

here is my code below

Code:
Sub Accounts_macro()
'
' Accounts_macro Macro
'

'
    Columns("C:CE").Select
    Selection.Delete Shift:=xlToLeft
    Range("B4").Select
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("E4").Select
    ActiveCell.FormulaR1C1 = "=R[-2]C[-1]-R[-2]C[-2]"
    Range("F4").Select
    Columns("F:F").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("F4").Select
    ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-2]"
    Range("E4").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
    Columns("H:H").Select
    Columns("I:I").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("I4").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
    Columns("J:J").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("J4").Select
    ActiveCell.FormulaR1C1 = "(h4-g4)/h4"
    Range("J4").Select
    ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-2]"
    Range("J5").Select
    Columns("J:J").ColumnWidth = 8.86
    Columns("M:M").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("M4").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
    Range("N4").Select
    ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-2]"
    Range("N5").Select
    ActiveWindow.SmallScroll ToRight:=1
    Columns("P:P").EntireColumn.AutoFit
    Range("N5").Select
    Selection.AutoFill Destination:=Range("N4:N5"), Type:=xlFillDefault
    Range("N4:N5").Select
    Columns("N:N").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("N4").Select
    ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-2]"
    Columns("Q:Q").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("Q4").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
    Columns("R:R").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("R4").Select
    ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-2]"
    Range("R5").Select
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 17
    Columns("U:U").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("U4").Select
    Columns("T:T").EntireColumn.AutoFit
    Columns("S:S").EntireColumn.AutoFit
    Range("U4").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
    Range("V4").Select
    ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-2]"
    Columns("Y:Y").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("Y4").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
    Columns("Z:Z").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("Z4").Select
    ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-2]"
    Columns("AC:AC").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AC4").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
    Columns("AD:AD").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AD4").Select
    ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-2]"
    Range("AD5").Select
    ActiveWindow.SmallScroll ToRight:=6
    Columns("AG:AG").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AG4").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
    Range("AH4").Select
    Columns("AH:AH").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AH4").Select
    ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-2]"
    Columns("AK:AK").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AK4").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
    Columns("AL:AL").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AL4").Select
    ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-2]"
    Range("AL5").Select
    ActiveWindow.SmallScroll ToRight:=7
    Columns("AO:AO").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AO4").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
    Columns("AP:AP").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AP4").Select
    ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-3]"
    Columns("AS:AS").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AS4").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
    Columns("AT:AT").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AT4").Select
    ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-2]"
    Range("AT5").Select
    ActiveWindow.SmallScroll ToRight:=6
    Range("Table_pastel_12_cust_rank[[#Headers],[2019-02]]").Select
   
    Range("AV5").Select
    ActiveWindow.SmallScroll ToRight:=7
    Columns("Aw:Aw").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("Aw4").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
    Columns("Ax:Ax").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("Ax4").Select
    ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-3])/RC[-3]"
      Range("AY4").Select
    ActiveCell.FormulaR1C1 = _
        "=RC[-48]+RC[-44]+RC[-40]+RC[-36]+RC[-32]+RC[-28]+RC[-24]+RC[-20]+RC[-16]+RC[-12]+RC[-8]+RC[-4]"
    Range("AZ4").Select
    ActiveCell.FormulaR1C1 = _
        "=RC[-48]+RC[-40]+RC[-36]+RC[-32]+RC[-28]+RC[-24]+RC[-20]+RC[-16]+RC[-12]+RC[-8]+RC[-4]"
        ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ShowTotals = False

ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ShowTotals = True
           
           
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(3). _
    TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(4). _
TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(5). _
TotalsCalculation = xlTotalsCalculationSum

ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(7). _
TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(8). _
TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(9). _
TotalsCalculation = xlTotalsCalculationSum

ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(11). _
TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(12). _
TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(13). _
TotalsCalculation = xlTotalsCalculationSum

ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(15). _
TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(16). _
TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(17). _
TotalsCalculation = xlTotalsCalculationSum

ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(19). _
TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(20). _
TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(21). _
TotalsCalculation = xlTotalsCalculationSum

ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(23). _
TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(24). _
TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(25). _
TotalsCalculation = xlTotalsCalculationSum

ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(27). _
TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(28). _
TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(29). _
TotalsCalculation = xlTotalsCalculationSum

ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(31). _
TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(32). _
TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(33). _
TotalsCalculation = xlTotalsCalculationSum

ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(35). _
TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(36). _
TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(37). _
TotalsCalculation = xlTotalsCalculationSum

ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(39). _
TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(40). _
TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(41). _
TotalsCalculation = xlTotalsCalculationSum

ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(43). _
TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(44). _
TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(45). _
TotalsCalculation = xlTotalsCalculationSum

ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(47). _
TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(48). _
TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(49). _
TotalsCalculation = xlTotalsCalculationSum

ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(51). _
TotalsCalculation = xlTotalsCalculationSum
ActiveSheet.ListObjects("Table_pastel_12_cust_rank").ListColumns(52). _
TotalsCalculation = xlTotalsCalculationSum

End Sub
↧

#divby0 help

April 6, 2020, 5:46 am
$
0
0
So i have this small problem.

lest say i have field a-b and c

a b c
0 0 #DIV/0!
0 10 1
10 0 -10
12 6 .5
I am trying to get growth. The only one that works is if there is data in both. if both values is 0 i need o
if first value has data and second value has 0 then it should be -100
if first value has no data but second hone has data then it should be 100

at this moment the code is
Code:
=(RC[-2]-RC[-3])/RC[-2]
↧
Search

[SOLVED] Delete row based on condition

April 6, 2020, 5:56 am
$
0
0
Dear Expert,
In attached file their is a table with column A,B,C,D,E,F,G & row 1 s column heading & row 2:9 is data range.
In my sheet i want to delete those row which row column B,D & F cell is blank from row 2.
In attached table i am highlighted manually row 6 because this row column B,D & F cell is empty.

Attached file for your ref.

Please help me to get the Code.

Best Regards
Wahid
Attached Files
↧
↧

Replace special characters in a filename individually

April 6, 2020, 5:58 am
$
0
0
Hi ...

Been searching the net, but in vain.

I am trying to replace the Norwegian special characters in a filename with certain illegal characters, like the æ, ø and å.

Like replace the "ø" with "o" and the "Ø" with "O" and so on.
There are three characters each in lower and upper case. I want to decide a replacement for each of them.

I found a plethora of solution that replace all illegal characters with the same character, mostly an underscore.
I have tried this solution, but it changed the mentioned characters all over the worksheet, not only i the set cell.

Code:

Sub ReplaceCharacters()
'Replaces special characters for English
Dim rCell As Range

If Target.Address = Worksheets("Faktura").Range("e13").Value Then

Worksheets("Faktura").Range("e13").Copy Worksheets("data").Range("A6")

End If


    For Each rCell In Worksheets("data").Range("A6").SpecialCells(xlCellTypeConstants, xlTextValues).Cells
        With rCell
            .Value = Application.WorksheetFunction.Substitute(.Value, "Ø", "O")
            .Value = Application.WorksheetFunction.Substitute(.Value, "ø", "o")
            .Value = Application.WorksheetFunction.Substitute(.Value, "Æ", "E")
            .Value = Application.WorksheetFunction.Substitute(.Value, "æ", "e")
            .Value = Application.WorksheetFunction.Substitute(.Value, "Å", "A")
            .Value = Application.WorksheetFunction.Substitute(.Value, "å", "a")
        End With
    Next rCell
End Sub
Can anybody here help me?
↧

compare between 2 excel in folder and output the result in a main excel

April 6, 2020, 6:04 am
$
0
0
Hi,

Can you please help..
i need to compare a set of corresponding "Product excel" Vs "Consolidate excel" every month, from folder D:\test\Files.
In "A012_ProductFile_January2020.xlsx " cells B2(CODE), B3(ID), D3(CATEGORY), E3(AMOUNT)
against A012_Consolidate_January2020.xlsx cells A3, A4(ID), C4(CATEGORY), D4(AMOUNT)

I have a Main "COMPARE" excel contain the compare button and details for header
PRODUCT FILE | CONSOLIDATE FILE | RESULT |DATE COMPARISON DONE

e.g
A012_ProductFile_January2020.xlsx
A012_Consolidate_January2020.xlsx
B014_ProductFile_January2020.xlsx
B014_Consolidate_January2020.xlsx
C020_ProductFile_January2020.xlsx
D022_Consolidate_January2020.xlsx


The result can be match, mismatch, file missing.
↧

Macro to sort Columns in correct oder

April 6, 2020, 6:32 am
$
0
0
I have data that I import and need the columns copied/sorted in a specific order

The column headers will always start from Row5 and the data will be below this

I have show in row 4 what sequence the headers must be in

It would be appreciated if someone can provide me with code to ensure the columns are in the correct sequence
↧

Userform ComboBox not populating with external Range

April 6, 2020, 6:54 am
$
0
0
I have a userform with 2 comboBoxes on that needs to get it's named ranges from an external workbook.
The Useform show without any errors, but the comboBoxes are empty.
I added as much code as might be needed below and marked the sections I think might be the problem in bold red

Any suggestion will be greatly appreciated.


Code as follows (Shows "main" sub that's calling userform and namedRanges, as well as the subs for the userform and named ranges)
Code:
Sub NamedRanges(wb As Workbook, wSh As Worksheet)

    'declare variables to hold row and column numbers that define named cell range (dynamic)
    Dim myFirstRow As Long
    Dim myLastRow As Long
 
    'declare object variable to hold reference to cell range
    Dim myNamedRangeDynamicVendor As Range
    Dim myNamedRangeDynamicVendorCode As Range
 

    'identify first row of cell range
    myFirstRow = 2
 

    'Vendor Name range
    With wSh.Cells
 
        'find last row of source data cell range
        myLastRow = .Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
       
        'specify cell range
        Set myNamedRangeDynamicVendor = .Range(.Cells(myFirstRow, "A:A"), .Cells(myLastRow, "A:A"))
 
    End With
 
    'create named range with workbook scope. Defined name is as specified. Cell range is as identified, with the last row being dynamically determined
    wb.Names.Add Name:=myRangeNameVendor, RefersTo:=myNamedRangeDynamicVendor

    'Vendor Code range
    With wSh.Cells
 
        'specify cell range
        Set myNamedRangeDynamicVendorCode = .Range(.Cells(myFirstRow, "B:B"), .Cells(myLastRow, "B:B"))
 
    End With
 
    'create named range with workbook scope. Defined name is as specified. Cell range is as identified, with the last row being dynamically determined
    wb.Names.Add Name:=myRangeNameVendorCode, RefersTo:=myNamedRangeDynamicVendorCode

End Sub



' Returns the textbox value to the calling procedure
Public Property Get Vendor() As String
    VendorName = cboxVendorName.Value
    VendorCode = cboxVendorCode.Value
End Property
 
Private Sub buttonCancel_Click()
    ' Hide the Userform and set cancelled to true
    Hide
    m_Cancelled = True
End Sub

' Hide the UserForm when the user click Ok
Private Sub buttonOk_Click()
    Hide
End Sub

' Handle user clicking on the X button
Private Sub FrmVendor_QueryClose(Cancel As Integer _
                                  , CloseMode As Integer)
   
    ' Prevent the form being unloaded
    If CloseMode = vbFormControlMenu Then Cancel = True
   
    ' Hide the Userform and set cancelled to true
    Hide
    m_Cancelled = True
   
End Sub
Private Sub FrmVendor_Initialize()

'add column of data from spreadsheet to your userform ComboBox
With Me
    cboxVendorName.RowSource = ThisWorkbook.Names(Split(.Tag, "|")(0)).Address(external:=True)
    cboxVendorCode.RowSource = ThisWorkbook.Names(Split(.Tag, "|")(1)).Address(external:=True)
   
End With
cboxVendorCode.ColumnCount = 2
     
End Sub


Sub Macro5()
'
' SDCPrepTemp Macro

Dim wb As Workbook
Dim ws As Worksheet
Dim path As String
Dim MainWB As Workbook
Dim MasterFile As String
Dim MasterFileF As String

Set ws = Application.ActiveSheet
Set MainWB = Application.ActiveWorkbook

Application.ScreenUpdating = False

'Get folder path
path = GetFolder()
If path = "" Then
    MsgBox "No folder selected. Please start macro again and select a folder"
    Exit Sub
Else
End If



MasterFile = Dir(path & "\*Master data*.xls*")
MasterFileF = path & "\" & MasterFile

'Check if workbook open if not open it
If Not wbOpen(MasterFile, wb) Then
    Set wb = Workbooks.Open(MasterFileF, False, True)
End If


'Count visible worksheets
Dim i As Integer
Dim wSh As Worksheet

i = 0

For Each ws In wb.Worksheets
    If ws.Visible = True Then
        i = i + 1
    End If
Next ws

'if more then 1 sheet visible then prompt to choose one
If i > 1 Then
    MsgBox "More than one worksheet visible, please edit 'Master data' File to have only the 1 worksheet visible that it needs to use, and rerun macro"
    Exit Sub
Else
'If only 1 sheet visible use sheet name
    Set wSh = wb.ActiveSheet
End If

'Set Vendor Name and Code Range names
Call NamedRanges(wb, wSh)


'Select Vendor name and Vendor code with User Form and set variables
 
    ' Display the UserForm
With New FrmVendor
    .Tag = myRangeNameVendor & "|" & myRangeNameVendorCode
    .Show
End With

    VendorName = FrmVendor.cboxVendorName.Value
    VendorCode = FrmVendor.cboxVendorCode.Value
   
       
    ' Clean up
    Unload FrmVendor
    Set FrmVendor = Nothing
↧
↧

[SOLVED] Change color of part of the word

April 6, 2020, 7:13 am
$
0
0
Hello,
I think this macro might either be a really simple one or really complicated, not sure.

I have two coloumns that each row has the same word in different spelling, and I need a macro (or formula) that can change the color of consonants in column A that are different than those in column B. Please see the attached Excel for an example.

Thank you.
Attached Files
↧

Dynamic Currency Conversion

April 6, 2020, 8:36 am
$
0
0
Hello -

I am currently trying to develop a macro button that will convert all currency in a workbook to a different foreign currency and back simply.

In my example, I will be trying to change from USD to British Pounds. The model spans multiple worksheets and has numbers formatted as "Accounting" & "Currency". My current script is below, however it only changes numbers formatted as 'Currency' and not numbers formatted as 'Accounting'. Does anyone know what I am doing wrong?

Any help would be greatly appreciated.

Code:
Private Sub Currency_Converter_Click()
Dim theSheet As Worksheet
Dim c As Range
Dim dRate As Double

dRate = Worksheets("Currency_Conversion").Range("A1").Value

For Each theSheet In ActiveWorkbook.Sheets
For Each c In theSheet.UsedRange
If Left(c.Text, 1) = "$" Then
c.Value = c.Value * dRate
c.NumberFormat = "[$€-x-euro2] #,##0.00"
End If
Next c
Next theSheet
End Sub
↧
Search

Save as PDF & email

April 6, 2020, 8:52 am
$
0
0
Hi I am trying to save a document as a PDF & email it. This is the code I have been using to save as PDF, I just don't know how to email it. I have seen a few examples however it's pretty important that the file name is correct. Is it possible to modify this to have the email address = A1, Subject =B1 & Just a generic message I can change?

Code:
Sub SAVEPDF()
'
' SAVEPDF Macro
'
   
    Dim FName          As String
    Dim FPath          As String
    Dim username As String
    Dim PDF As String
   
    username = Environ$("username")
   

PDF = "C:\Users\" & username & "\Dropbox\Quotations To Be Emailed\" & ActiveSheet.Range("K3").Value & ".PDF"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDF
   
End Sub
↧

Automatically advancing a schedule time based on the current time

April 6, 2020, 9:05 am
$
0
0
Hello,

Project Overview: I am attempting to build a room scheduling tool for a moderately sized clinic. I found a room booking tool at a free online site to learn excel (I am not sure I can post the site here but will if I can). Of course, it does not meet my needs exactly so I am trying to make some adjustments. Most significantly, I am trying to break the day down into 15-minute increments. Eventually, I would like the tool to consider the current date and time and be able to fill in the room occupant for the time frame they specify. I would like to have people be able to fill in days in the future and look back as past days.

Current Help Request: I would like to set the displayed array to the current date a time in a 5 hour range (starting 15 minutes prior to the current time) that can advance or reverse 5 hours at a time depending on which button the user chooses. I really don’t need to see any times between 7 pm and 7 am.

As you can see, I am having difficulty getting the date accurate and having the date change at midnight.

I truly appreciate any help on this project.
↧
↧

Source file locked after running Marco FSO.CopyFile

April 6, 2020, 9:11 am
$
0
0
After running FSO.CopyFile (sSFolder & sFile), sDFolder, True
copy file from
C:\Users\User\AppData\
to
wherever destination.

source file locked and cannot be deleted or edit even close the xlsm file.

I need to reboot then I could have access to that file.

I have two laptops but only one having this problem.

Besides, there is no problem when I run the same macro to copy file from

C:\Users\User\
to
wherever destination

I have cross checked "C:\Users\User\AppData\" permission and security setting from two laptops but no clue.

Please help
↧

Hide / Unhide pictures with VBA

April 6, 2020, 9:43 am
$
0
0
Dear Forum,

I am a new member with a problem. Hope one of you can help me out....
I have the following code in VBA to hide some objects on my screen


Sub verberg()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Home")

sh.Unprotect "xxx"
ActiveWindow.SmallScroll Down:=-3
ActiveSheet.Shapes.Range(Array("Vorm1")).Visible = msoFalse
ActiveSheet.Shapes.Range(Array("Vorm2")).Visible = msoFalse
ActiveSheet.Shapes.Range(Array("Vorm3")).Visible = msoFalse
ActiveSheet.Shapes.Range(Array("Vorm4")).Visible = msoFalse
ActiveSheet.Shapes.Range(Array("Vorm10")).Visible = msoFalse
End Sub

The strange thing is it works flawless in debugging mode (F8) but it fails to work when called as a procedure.

Does anyone know what I am doing wrong ?

Thanks in advance for your feedback.

Kind regards from Belgium.
Tom.
↧

Linking tab to another sheet with same tab name

April 6, 2020, 10:53 am
$
0
0
So I've been tasked with automating the weekly stats and I've come up against this issue.
I have 5 team members collating weekly stats and need to feed them into a weekly managers information sheet. I want to make this as automated as possible.
Each staff member has a workbook and each worksheet within the book is for each week of the year. The MI sheet has the weekly total of all staff members.
Linking the data is straightforward for each worksheet but I want to be able to automate it so that the formula update to read From the corresponding datesdd worksheet on the individual staff. Rather than having to link individually to each cell 52 times.

Is this possible?
↧
Viewing all 49870 articles
Browse latest View live
Search