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

Named Ranges Error

$
0
0
Hi

I have created some named ranges that contain pictures that I am then trying to copy over into a particular Venn format on another sheet.

The pictures can vary in number for each of the 4 groups and are named before copying across onto sheet(2) (Massive thanks to DaveXL for the help).

However when I copy the code over onto my master sheet, I get the error " 'Group2Pic1' does not exist ...". These NamedRanges are meant to be auto-generated. Also none of the other group pictures are loaded (and no named range are auto-generated at all for the other groups.) I fI manually create Group2Pic1, then the error will say Group2Pic2 doesn't exist etc.

I have attached a working example (dummy data) so you can see what I mean. I don't understand why when copying the exact same code over onto my master sheet I should be getting the above error. I have checked and made sure there are no any over-lapping named ranges generated that were pre-created before the code is run.

Can anyone help please? I 'm sure it's something simple but cannot figure it out.

Many thanks in advance.
Attached Files

XlXTRFun addin subsitute

$
0
0
Hi,

I am trying to find a workaround for the spline function found in XlXTRFun add in no longer working in 64 bit environments.

I have found a work around see code below. However the code only accounts for x and y data to be in columns and not rows as well.

Is there any easy way to allow this code to be able todeal with x and y base data in rows or columns rather than just in columns?

Any help would be much appreciated as most of my templates no longer work on my 64 bit machine.

Best wishes,

Chartwiz

VBA Module 1 Spline data
3 0.44467531752 Result from 'SplineInterpolate' function based on input of 3 and base figures below:


x y
0 0.305
0.10022 0.32
0.27539 0.341388
0.85528 0.381388
1.32224 0.401708
1.69248 0.413752
2.46828 0.433354
3.43106 0.452996
5.3022 0.482379
7.77429 0.511557
8.9451 0.522962
13.53592 0.561209
17.68 0.589



Heres the code:


Public Function SolveForDerivatives(xArray As Range, yArray As Range)
Dim y As Variant
x = xArray.Value2
y = yArray.Value2

Dim NumPoints As Integer
NumPoints = UBound(y) - LBound(y) + 1

Dim a As Variant
Dim w As Variant
ReDim a(1 To NumPoints, 1 To NumPoints)
ReDim w(1 To NumPoints, 1 To 1)

For i = 1 To NumPoints
For j = 1 To NumPoints
a(i, j) = 0
Next j
Next i

x1Diff = x(2, 1) - x(1, 1)
xNDiff = x(NumPoints, 1) - x(NumPoints - 1, 1)

a(1, 1) = 2 / x1Diff
a(1, 2) = 1 / x1Diff

a(NumPoints, NumPoints - 1) = 1 / xNDiff
a(NumPoints, NumPoints) = 2 / xNDiff

w(1, 1) = 3 * (y(2, 1) - y(1, 1)) / x1Diff ^ 2
w(NumPoints, 1) = 3 * (y(NumPoints, 1) - y(NumPoints - 1, 1)) / xNDiff ^ 2

For i = 2 To NumPoints - 1
xLowerDiff = x(i, 1) - x(i - 1, 1)
xUpperDiff = x(i + 1, 1) - x(i, 1)

a(i, i - 1) = 1 / xLowerDiff
a(i, i) = 2 * (1 / xLowerDiff + 1 / xUpperDiff)
a(i, i + 1) = 1 / xUpperDiff

w(i, 1) = 3 * ( _
(y(i, 1) - y(i - 1, 1)) / xLowerDiff ^ 2 + _
(y(i + 1, 1) - y(i, 1)) / xUpperDiff ^ 2 _
)
Next i

Dim Ainverse As Variant
Ainverse = WorksheetFunction.MInverse(a)



For i = 2 To NumPoints - 1

Next i

SolveForDerivatives = WorksheetFunction.MMult(Ainverse, w)

End Function


Public Function SplineInterpolate(xArray As Range, yArray As Range, xInRange As Range)
Dim y As Variant
x = xArray.Value2
y = yArray.Value2

Dim yDerivs As Variant
yDerivs = SolveForDerivatives(xArray, yArray)

Dim xIn As Variant
xIn = xInRange.Value2

If IsArray(xIn) Then
Dim NumOutPoints As Integer
NumOutPoints = UBound(xIn) - LBound(xIn) + 1

Dim yOut As Variant
ReDim yOut(1 To NumOutPoints, 1 To 1)

For i = 1 To NumOutPoints
yOut(i) = InterpolateOnePoint(x, y, yDerivs, xIn(i))
Next i

SplineInterpolate = yOut
Else
SplineInterpolate = InterpolateOnePoint(x, y, yDerivs, xIn)
End If


End Function

Private Function InterpolateOnePoint(xs As Variant, ys As Variant, yDerivs As Variant, x As Variant)
NumPoints = UBound(ys)

If x <= xs(1, 1) Then
InterpolateOnePoint = ys(1, 1) + yDerivs(1, 1) * (x - xs(1, 1))
GoTo EndFunction
ElseIf x >= xs(NumPoints, 1) Then
InterpolateOnePoint = ys(NumPoints, 1) + yDerivs(NumPoints, 1) * (x - xs(NumPoints, 1))
GoTo EndFunction
End If

k = 1
Do While xs(k, 1) < x
k = k + 1
Loop

xDiff = xs(k, 1) - xs(k - 1, 1)
yDiff = ys(k, 1) - ys(k - 1, 1)

t = (x - xs(k - 1, 1)) / xDiff

a = yDerivs(k - 1, 1) * xDiff - yDiff
b = -yDerivs(k, 1) * xDiff + yDiff

InterpolateOnePoint = (1 - t) * ys(k - 1, 1) + t * ys(k, 1) + t * (1 - t) * (a * (1 - t) + b * t)

EndFunction:
End Function
Attached Files

Loop through Sheets to add new data to last row of Table - VBA

$
0
0
I am working on a solution to copy data from several Sheets to a single sheet and append it to the last row of an existing table. I have the code working except when the data is copied to the bottom of the srcWs it does not take the form of the current table. I am using UsedRange because there are gaps in the data from the actShtNames that could amount to several blank Rows being copied.


Code:

Dim srcWB As Workbook
Dim srcWs As Worksheet
Dim shtCount As Integer
Dim actShtName As String
Dim lRow As Long
Dim cEndRow As Long
Dim txt As Range
Dim tbl As ListObject

  'Set the SCR workbook and worksheet
  Set srcWB = Workbooks.Open("\\***")
  MsgBox (srcWB.Name)
  Set srcWs = srcWB.Worksheets("R_Data")
  srcWs.Activate

  'Get the current last row of the table of the srcWs
  cEndRow = Range("A" & Rows.Count).End(xlUp).Row
  'MsgBox (cEndRow)

    Set tbl = srcWs.ListObjects("Table1") 
  'For sheets that start at index after sheets 1-5 to end of workbook.

    For shtCount = Worksheets("1-5").Index + 1 To Worksheets.Count

    Sheets(shtCount).Activate
    actShtName = ActiveSheet.Name

      If actShtName = "R_Data" Or actShtName = "Warehouse_Data" Or actShtName = "Sheet2" Then
    'If Sheet is R Data then ignore the sheet. That is the src worksheet that houses data
    'Also ignore Warehouse data and sheet2

        Else
            'MsgBox (actShtName)
            If Worksheets(actShtName).UsedRange.Count > 1 Then
                lRow = srcWs.Range("A" & Rows.Count).End(xlUp).Row
                'MsgBox (lRow)
                With Worksheets(actShtName).UsedRange
                srcWs.Cells(lRow + 1, 1).Resize(.Rows.Count, _
                .Columns.Count).Value = .Value
            End With
            End If
        End If

    Next shtCount

  'Delete any duplicate headrs that are copied over

      For Each txt In srcWs.Range("A2:A" & lRow)
        If txt.Value = "Supply Name" Then
            txt.EntireRow.Delete
        End If
      Next txt

If Not (NamedRange) is nothing Then gives an error

$
0
0
I have a named range that holds a value.

I am trying to make an If statement like this:

Code:

If Not (Named Range) is Nothing Then
But it seems it is not the right way, as I get an error.

Any Help will be much appreciated

[SOLVED] VBA, SMS, Error in Body Text Code.

$
0
0
Hello, after much help on this topic I seemed to have made a mistake in the code which I can't see after amending some wording.
Could someone take a look and let me know where its gone wrong please.

Thank you


.Body = "Your Collection No." & Range("c" & useRow).Value & " Is Scheduled For Tomorrow, " & Range("c1").Value & " at " & Range("a" & useRow).Value & ".When You Arrive Please Stay In Your Vehicle, Your Order Will Be Brought Out At Your Allotted Time.*Text End*"

Re: "Running Count by Hour of the Day" thread

$
0
0
Hi,

I am looking at this old thread https://www.excelforum.com/excel-for...the-day-2.html

and I want to know exactly what posts 15 shows me?

https://www.excelforum.com/excel-for...ml#post5202317

So I would be glad if someone could explain exactly what this DAX formula does?

Code:

Active Customers:=CALCULATE (
                COUNTROWS ( Customers ),
                FILTER (
                        Customers,
                        Customers[Exit Time] >= MIN( Times[Time] ) &&
                        Customers[Arrival Time] <= MAX ( Times[End Time] )
                )
        )

Se #15 in link above for image of Times[Time] table.

Loop columns using RC method

$
0
0
This is somewhat a fun problem. My routine uses RC to define a formula. I'm having difficulties in looping through to get my result - specifically I need the formula array to populate the range from last column +1 to n amount of original columns. If anyone could offer some suggestions, I would be greatly appreciative.
Code:

Sub Step1Spline(StartCell As Range, Header As String, FirstN As Integer, LastN As Integer, StepN As Integer)
   
        i = FirstN
        r = 1
       
            With ws
                For i = FirstN To LastN Step StepN
                    StartCell.Cells(1).Offset(r, 0).Value = i
                    i = i
                    r = r + 1
                Next i
                    SplineRow = r
                    lCol = LastCol(sh)
                    sCol = lCol + 1
                For k = sCol To sCol + 1 'column after depth to very last column
                    For j = 2 To lCol - 1
                        .Range(.Cells(SplineRow, 2), .Cells(SplineRow, sCol)).FormulaArray = "=csplinea(R2C1:R" & lrow & "C1,R2C" & j & ":R" & lrow & "C" & j & ",R2C" & sCol & ":R" & .Range("A" & lrow) - .Range("A2") + 1 & "C" & sCol & ")"
                        ''example output within cells would be ={cslinea($A2:$A200,$B2:$B200,$F2:$F23984)} column E:E is populated by "r"
                        ''final range example output would be = {cslinea($A2:$A200,$E2:$E200,$I2:$I23984)} because range I:I would be initiated by D:D
--- loop would then exit
                    Next
                    If j = lCol Then GoTo Safe_Exit
                    sCol = LastCol(sh) 'very last column
                Next
            End With

Change search code to search in many sheets

$
0
0
Hi I have below code. It works now brilliant when it search after words. It can find xlpart also so its very good and i have used it before to search in sheets with many rows.
The testsearch workbook i have attached.
In Sheet 1 there is a command button to search in the sheets.
The code search now in Sheet2. It copy the found matches which can be part to sheet "Searchresult"
I would like to have it search in sheet2 to Sheet11 all 1o sheets. copy the matches or part matches to sheet "Searchresult"
But without change too much in the code, because the searchresult are really good.
I would like also to have in sheet "Searchresult" in column C, which write which sheet its found in.
To that i can say you cant add any help column in sheets 2 to Sheets 11, if that needed it have to be in column AL, because in the real workbook, there
are many other columns.
If some can find out would be really great. The code is as below and it now as said only search in Sheet2. I have attached a testworkbook, so you
can have a look at that.

Thanks in advance
Sincerely
Abjac


Code:

Dim filename, sh As Worksheet, LR
Sub SetWorksheet1()
Sheets(2).Activate
Set sh = ThisWorkbook.Sheets("Searchresult")
LR = sh.Cells(Rows.Count, "A").End(xlUp).Row

Dim k As Long, j As Long
Dim myWord As String
Dim myRng As Range
linestart:
myWord = InputBox("What company you want to find?")
j = LR + 1
If myWord <> "" Then
  For k = 1 To Cells(Rows.Count, "A").End(xlUp).Row
    With Range("A" & k & ":H" & k)
      Set c = .Find(myWord, LookIn:=xlValues)
      If Not c Is Nothing Then
        Sheet2.Rows(k).Copy sh.Rows(j)
        j = j + 1
     

       
      End If
    End With
  Next k
Else
  Exit Sub
End If
If j = LR + 1 Then

  MsgBox "Not found, Try again with another search Word"
  GoTo linestart
 
 
End If
End Sub



Attached Files

VBA Array Formula Not Working

$
0
0
Hello,

I have this array formula in an excel workbook:

{=INDEX('[Migration_-_Client and Account_Data_Report.xlsx]Migration - Account Information'!$Z:$Z,SMALL(IF('[Migration_-_Client and Account_Data_Report.xlsx]Migration - Account Information'!$A:$A=$C31,ROW('[Migration_-_Client and Account_Data_Report.xlsx]Migration - Account Information'!$A:$A)-ROW(INDEX('[Migration_-_Client and Account_Data_Report.xlsx]Migration - Account Information'!$A:$A,1,1))+1),1))}

What it's doing is looking for an account specific detail (let's say account owners) based on a specific account number. The account number may appear multiple times in the spreadsheet if it has more than one owner. I need the get the names of each owner into my current workbook.

I know this gets the desired result, and I can create a unique list by increasing the last "1" each time.

My problem is when I try and re-create this in VBA

This is how I've tried to re-create the formula in VBA:

Dim PN As Long

PN = WorksheetFunction.CountIf(SWPAWS.Range("A:A"), OAR) 'SWPAWS is the worksheet with the raw data. OAR is the Account Number
Dim Z As Long

For Z = 1 To PN


'Account Owner

Range("B" & NR).Value = "Account Owner"

SDAR.Range("C" & NR).FormulaArray = "=INDEX(" & SWPAWS & "!Z:Z,SMALL(IF(" & SWPAWS & "!A:A=" & OAR & ",ROW(" & SWPAWS & "!A:A)-ROW(INDEX(" & SWPAWS & "!A:A),1,1))+1)," & Z & "))"


'TBC

I've tried multiple ways for writing the formula. Even recorded the macro. Nothing seems to work when replicated.

Any help or guidance with this would be much appreciated.

VBA to create graphs

$
0
0
Hi Folks,

I would really appreciate help on how to create VBA code to create my graphs.

I tried creating a macro, but quickly realized VBA code would be required.
For the macro code kept referring to a specific range of cells.
In my situation, the range of cells that needs to be graphed will keep changing.

So here's what I'd like to be able to do (worksheet provided).

I will manually place the cursor at the top of a Station name, let's say PlaceB.
I would like the VBA to select cells A11..C19.
Then create a Bar graph (ChartType = xlColumnStacked)
And finally, if possible, Select the graph and Copy it.

I will then manually select the appropriate worksheet and paste it there at the correct location.

Of course for the next graph, the range of cells selected will be different, always governed
by the range of Station name.
Attached Files

[SOLVED] Why i get error 1004. Formula in Cell

$
0
0
Hello guys,
i try write some Macro. And i don`t know why i get a 1004 error. I am from Poland so functions name are in Polish. Mod1_data_zakonczenia_zlecenia is a function

I have this code:

Code:

Sheets("Harmonogram").Range("O" & ilosc_Wierszy_Harmonogram).FormulaR1C1 = "=Mod1_data_zakonczenia_zlecenia(RC[-12]    ;    RC[-4]      ;    RC[-2])"
Przechwytywanie.PNG



SOLVED

correct code

Code:


Sheets("Harmonogram").Range("O" & ilosc_Wierszy_Harmonogram).FormulaR1C1 = "=Mod1_data_zakonczenia_zlecenia(RC[-13]  ,    RC[-4]  ,    RC[-2])"

Application-defined or object defined error

$
0
0
I'm getting an "Application-defined or object defined error". I suspect that it is related to my Dynamic Dimensional Array. I read an article that instructed to switch (rows, cols) to (cols, rows) and then use Transpose when working with Two Dimensional Dynamic Arrays but I wasn't having much success with that so I switched them back to normal. That was still not the solution
.
Thanks to anyone willing to take the time to check this out and point out how to correct the error.
Attached Files

userform not showing up error

Google Sheets Macro?

$
0
0
I am not sure if this is a Macro or even possible in google sheets. In my sheet I have numerous rows of information with one column with a quantity, at some point i give the cell with the quantity a background fill color of yellow. Not the whole column just certain cells. Is there anyway to automate the process of taking that entire row that has the highlighted cell and move it to another sheet in google sheets? Ultimately deleting it off the original sheet? Hope I made sense.

Loop to fill cells in named sheets

$
0
0
I need a macro to loop thru the range in A11:A14 and fill the cells in each sheet . Sheet AA shows the desired results. Use indirect?
Attached Files

Creating a User-Defined Range for Formulas

$
0
0
Hey Folks,

I'm trying to generate an InputBox that allows the user to define the variable that will determine the range for the values spit out by a Macro.

inputvalue = Application.InputBox(prompt:="Please enter a number.", Title:="Enter a Number", Type:=1)
If inputvalue = ("1") Then Range = ("f2")
If inputvalue = ("2") Then Range = ("f2:f3")
If inputvalue = ("3") Then Range = ("f2:f4")
If inputvalue = ("4") Then Range = ("f2:f5")
If inputvalue = ("5") Then Range = ("f2:f6")
If inputvalue = ("6") Then Range = ("f2:f7")
If inputvalue = ("7") Then Range = ("f2:f8")
If inputvalue = ("8") Then Range = ("f2:f9")
If inputvalue = ("9") Then Range = ("f2:f10")
End If
inputvalue= ("0")

I keep getting an argument not optional error, and I'm unsure as to what it means here. I'm relatively new at this, and could use any help!

Thanks folks,
NP

Getting the chart labels from VBA

$
0
0
Is there a way I can pull these labels from a pivot chart with VBA? I've looked through various methods and properties under "ActiveSheet.ChartObjects("MyChart").chart.SeriesCollection(1)" but can't find out how to do it. I can pull the values, just not the labels. I need the days I have data for so I can dynamically filter another pivot table.

chart.PNG

VBA Loop a macro

$
0
0
Hi all, I have little VBA experience and have been searching online to try and solve my current issue.

I have a spreadsheet which I am formatting (recording macros), and as part of this I want to search a column for a cell that contains a value, and if found move it across one cell using offset. After searching online i have got to a point where it will find a value I have set and move across, but only once value at a time.

Sub MoveTheCell()
Dim rngFound As Range
Set rngFound = Cells.Find(What:="56", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
rngFound.Cut Destination:=rngFound.Offset(0, 1)

Set rngFound = Nothing
End Sub


Issues:
  • Continue to run until no other value is found, then move to the next macro
  • Only run the macro if the value is found in the first place, otherwise skip to the next macro
  • Delete column once complete


I will have a separate macro to delete all empty rows and columns

Thanks for your help!

[SOLVED] Copy data when cell values match

$
0
0
Hi. I'm a VBA novice.
I found this code which almost does what I want, but I'm missing a repetitive action.
The requirement is to scan a column on one sheet, make a value match with a column on another sheet, and then copy over data in the row.
It works except in the first sheet the matching value only occurs once, but on the second sheet the value may occur many times. This sub only pastes into the first occurrence on the second sheet, and does not repeat the paste for another other matches:

Search column E on sheet "Results"
Search column E on sheet "Pre".
Make a value match.
Copy over partial row from "Results" to "Pre" on a value match (for all values that match not just first match).

Code:

Sub sampledata()
Dim NewDataRng As Range
Dim Cel As Range
Dim OldDataRng As Range
Dim MatchingValueCell As Range
Dim LastRow As Long

With Sheets("Results")
    LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    Set NewDataRng = .Range("E2:E" & CStr(LastRow))
End With
 
With Sheets("Pre")
    LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    Set OldDataRng = .Range("E2:E" & CStr(LastRow))
End With
 
For Each Cel In NewDataRng
    Set MatchingValueCell = OldDataRng.Find(What:=Cel.Value, _
              After:=OldDataRng.Cells(OldDataRng.Cells.Count))
    If Not MatchingValueCell Is Nothing Then _
      Cel.Resize(1, 126).Copy MatchingValueCell
Next Cel
End Sub


Thank you.
Attached Files

How to extrapolate numbers from a single string and asign them to different integers?

$
0
0
So, I don't know if there's any vba code in the world that can do this.

Context: I started working in this place registering big orders. Before the quarantine it was about 150 per week and I have to talk to every customer in the mean time, so when I arrived and saw that the data base was all excel and it was all quite messy the least I could do was make it as fast and organized as possible. One problem I solved was for when a special offer was order, as in 'two for the price of one' or 'twelve for the price of nine'. To correctly identify what to manually modify in the receipt before it was printed we write 9s 3f as in 9 sold and 3 free. I added an input box whenever Excel tried to substract a string to an integer so it just asked how many are there in total and then I have to manually go to the receipt and add a second row where I have to make sure one row has 9 with it's correspondant price, and the second one the 3 with 0 cost.

Adding a column for every possible offer is not viable, as I would have to modify so many other things it's just not worth it, more so when we also use this format when a cliente wants to return something for x reason, so we write down 2c as in change or whatever, it just needs to be a string, to again not miss the obvious receipt with many broken formulas so we go and manually fix it. Also, I know I could have two inputboxes instead of one and my problem would be solved, but having to be there and make sure you type in every inputbox really slows you down, as you could be taking care of other things and these macros in our work computers take a looooong time to run. I want the code to be able to do everything on its own, only having msgboxes and inputboxes as a safety measure.

Now that you have the context (if you need it), what I initially would love to do is a code that can identify the different integers in a string. If I can just have this code recieve '9s 3f' asign the 9 to an S integer and the 3 to an F integer I can easily do the rest, but I don't know how to get to that. I've seen some that come close to it, decomposing the string into every individual character and then deleting everything that is not a number. The problem is that in that case, I'll be left with a single integer which's value is 93 and it's going to be worse if I have '12s 4', it will recognise the 12 as a 1 and a 2.

If anyone knows a code that can do this, or is just very smart and has a different solution to this I would really apretiate it!

Edit: The Example I attached is a very very basic example of what happens, as the process is much slower. You have to input everything manually. What I would love to do is a code that leaves me with that exact same end result without having to input it myself.
Attached Files
Viewing all 49820 articles
Browse latest View live