Posts by fzz

?

'=&'''N:\INVOICES\Store A\[12-30-19.xlsm]Cost'!$L$109 isn't a valid formula.

If you mean you have formulas returning text which look like external references, then unless the workbooks to which those external references pointed were all open in the same Excel session, the only way to turn those formulas into actual external references would be to copy those cells, paste-special as values then replace = with = in those cells (yes, replace = with itself, which has the effect of reentering the text constants as formulas). There's no other simpler way to do this, though if you need this often, you may want to create a macro in your PERSONAL.XLSB for this.

Sub textref2extref()
  Dim a As Range

  If Not TypeOf Selection Is Range Then Exit Sub

  With Application
    .ScreenUpdating = False
    .EnableEvents = False
  End With

  For Each a In Selection.Areas
    a.Value = a.Value
    a.Replace what:="=", replacement:="=", LookAt:=xlPart
  Next a

  With Application
    .ScreenUpdating = True
    .EnableEvents = True
  End With

End Sub

Try

Dim srcrng As Range, dstrng As Range
Dim n As Long

n = Worksheets("Sheet1").Range("A2").Value  '# replace "Sheet1" as needed; avoid codenames

Set srcrng = Worksheets("320").Range("N9:Q" & n)
Set dstrng = Worksheets("EW-RDS-DR").Cells(Rows.Count, 2).End(xlUp).Offset(4, 0)

With srcrng
  dstrng.Resize(.Rows.Count, .Columns.Count).Value = .Value
End With

A fragment of your code.

ID = Range("H1")
name = Range("H2")
eMail = Range("H3")
Department = Range("H4")
name = Application.WorksheetFunction.VLookup(ID, Sheet1.Range("A2:D1002"), 2, False)
eMail = Application.WorksheetFunction.VLookup(ID, Sheet1.Range("A2:D1002"), 3, False)
Department = Application.WorksheetFunction.VLookup(ID, Sheet1.Range("A2:D1002"), 4, False)

ID is undeclared, so the 1st statement would assign the value (.Value property) of cell H1 in the active worksheet to the Variant variable ID. The 2nd statement would assign the value of cell H2 to the string variable name. And similarly for eMail and Department. If you want cells H2:H4 replaced by the values from the VLOOKUP calls, you should replace the 2nd and subsequent lines above with something like

Dim k As Variant
k = Application.Match(ID, Worksheets("Sheet1").Range("A2:A1002"), 0)
If IsNumeric(k) Then
  With ActiveSheet
    .Range("H2").Value = Worksheets("Sheet1").Range("A2:D1002").Cells(k, 2).Value
    .Range("H3").Value = Worksheets("Sheet1").Range("A2:D1002").Cells(k, 3).Value
    .Range("H4").Value = Worksheets("Sheet1").Range("A2:D1002").Cells(k, 4).Value
  End With
Else
  MsgBox Title:="check_id macro error", Prompt:="ID [" & ID & "] not yet registered."
End If

It looks like there are other problems too, such as the For loop possibly iterating over many rows but performing the VLOOKUP call on the same ID value every iteration.

Transitions are from empty to nonempty or nonempty to empty. If there'd be a transition from ActiveCell to the cell immediately below it OR ActiveCell were empty, then ActiveCell.End(xlDown) would be the next nonempty cell OR to the bottommost cell in the column. If there'd be no transition AND ActiveCell were nonempty, then ActiveCell.Offset(1, 0) would be the next nonempty cell. Which suggests the following approach.

Dim c As Range
If Application.WorksheetFunction.CountA(ActiveCell.Resize(2, 1)) = 2 Then
  ActiveCell.Offset(1, 0).Activate
Else
  Set c = ActiveCell.End(xlDown)
  If Not IsEmpty(c.Value) Then c.Activate Else Set c = Nothing
  If c Is Nothing Then
    '# what do you want to do if there are no nonempty cells below ActiveCell?
  End If
End If

If you only need an e-mail when at least one cell in O3:O11 changes, better to use event handlers to e-mail the new cell values when they change whenever they change rather than checking every 2 minutes if there could be changes more frequently than that. If these cells usually contain constants (NOT formulas), a .Change event handler would be best. If they contain formulas, a .Calculate event handler would be best but would require caching the previous values for comparison.

davesexcel,

Sorry. skimmed your response and only noticed the PasteSpecial part.

There's a slow and fragile 3rd way: launch Notepad and use SendKeys to paste the source range into Notepad, then select all in Notepad, copy, switch back to Excel and paste into the destination range. Not recommended, but I figure I owed something original.

You just want source ranges' values in destination ranges? If so, for example replace

Range("C6:C1000").Copy Range("f6:f1000")

with

Range("f6:f1000").Value = Range("C6:C1000").Value

Not instructions but a warning: any workbook which can be opened can be hacked into pieces once opened. Any workbook which can be opened can be opened with macros DISABLED, meaning it's impossible to use macros robustly to protect workbooks which users can open.

If you want potential users to have to click on a button to register some kind of digital agreements to terms & conditions before being able to use your workbooks, you'd be FAR BETTER OFF having that button be on a web page on a web site, and once clicked it'd redirect the user who clicked it to another web page containing download links for your workbooks.

ADDRESS(CELL("row",ServiceFeesHdrs)+1,CELL("col",ServiceFeesHdrs)) &":"

& ADDRESS(CELL("row",ServiceFeesHdrs)+ROWS(ServiceFeesHdrs)-1,CELL("col",ServiceFeesHdrs))

This gives the text representation of a range within the range named ServiceFeesHdrs, but that's not a reference to that range. You could wrap this inside INDIRECT, but that'd mean an unnecessary use of the volatile function INDIRECT. Better to learn how to use the range operator : .

INDEX(ServiceFeesHdrs,2,1):INDEX(ServiceFeesHdrs,ROWS(ServiceFeesHdrs),1)

This is a reference to the subrange within ServiceFeesHdrs, and there are no volatile function calls. You could then replace _Services!$D$2:$D$3 in your INDEX formula with the expression above. That said, if _Services!$D$1 (presumably the top-left cell in ServiceFeesHdrs) were blank or was unlike the other cell values in D2:D3, you could use MATCH($D$2,INDEX(ServiceFeesHdrs,0,1),0)-1 as the 2nd argument in your INDEX formulas.

Tangent: there's NEVER a good reason to use INDIRECT(ADDRESS(...)) or ADDRESS(...) itself unless the worksheet portion of the range address would be variable. Even then there are alternatives which avoid using volatile functions. ADDRESS is a function which appears useful but generally causes more problems than it solves. The function analog to using merged cells.

Are you using Excel 2016 or later? If so, you could use formulas.

With your original data in A2:C16, E2 would be =A2, F2 would be =TEXTJOIN(",",1,IF($A$2:$A$16=E2,$B$2:$B$16,"")) [and array formula], and G2 would be =SUMIFS($C$2:$C$16,$A$2:$A$16,E2). Fill E2:G2 down into E3:G16 to produce the 2nd table above.

If you believe you have to do this with VBA, and without using TEXTJOIN, but assuming the source range is sorted on the 1st column,

Sub Task111()
  Dim j As Long, k As Long, rng As Range

  Set rng = ActiveSheet.Cells(Rows.Count, 1).End(xlUp)
  If rng.Row = 1 Then Exit Sub '# col A empty below row 1, nothing to do
  Set rng = Range(ActiveSheet.Cells(2, 1), rng)

  With rng
    For j = 1 To .Rows.Count
      If j = 1 Or .Rows(j - 1).Value <> .Rows(j).Value Then
        For k = j + 1 To .Rows.Count
          If .Rows(k).Value = .Rows(j).Value Then
            .Rows(j).Offset(0, 1).Value = .Rows(j).Offset(0, 1).Value & "," & .Rows(k).Offset(0, 1).Value
          Else
            Exit For
          End If
        Next k
        .Rows(j).Offset(0, 2).Value = Application.WorksheetFunction.Sumifs(.Offset(0, 2), .Cells, .Rows(j).Value)
      Else
        .Rows(j).Resize(1, 3).Value = .Rows(j - 1).Resize(1, 3).Value
      End If
    Next j
  End With
End Sub

You're welcome.

Re the Me. reference, I had assumed your _Click procedure was in a worksheet class module. If that had been the case, Me. would have referred to that worksheet.

On a tangent, what does i = Evaluate("=MATCH(" & CStr(CDbl(d)) & ",wrng2,-1)") set i to?

Actually, that's a bit dangerous as the Evaluate call could return #NA, so maybe better to use a variable of type Variant to hold the return value, then check whether it's an error value using IsError().

Tangents first. Your line 30 could be reduced to

Workbooks.Open Filename:=file.Path, Fomat:=1

OTOH, why bother using FileSystemObject?

Purely as style, VBA procedures you may need to call from multiple worksheets should be in separate procedures. IOW, the only VBA code which should be in class modules where a _Click procedure would be found should be specific to that particular control. That doesn't appear to be the case here. Better to move most of the code out of the _Click procedure and into a general module.

My approach would be

'in Sheet6 class module
Private Sub Sheet6_Button1_Click()
  ProcFiles "C:\test", Me.Range("A2")  '# calls a procedure in a general module 
End Sub

Sub ProcFiles(myfolder As String, dstrng As Range)
  Dim fn As String, owd As String
  Dim rng As Range, dwb As Workbook

  On Error GoTo CleanUp
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Application.Calculation = xlCalculationManual

  owd = CurDir
  If Mid$(myfolder, 2, 1) = ":" Then ChDrive Left$(myfolder, 2)
  ChDir myfolder

  fn = Dir$("*.txt")
  Do While fn <> ""
    Debug.Print fn
    Set dwb = Workbooks.Open(Filename:=fn, Format:=1)
    Set rng = dwb.ActiveSheet.UsedRange
    With rng
      Set dstrng = dstrng.Resize(.Rows.Count, .Columns.Count)
      dstrng.Value = .Value
      dstrng.Columns(1).FormulaR1C1 = Left$(fn, 6)
      Set dstrng = dstrng.Offset(.Rows.Count, 0).Resize(1, 1)
    End With
    dwb.Close savechanges:=False
    fn = Dir$
  Loop

CleanUp:
  If Mid$(owd, 2, 1) = ":" Then ChDrive Left$(owd, 2)
  ChDir owd
  Application.Calculation = xlCalculationAutomatic
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True

End Sub

A different take on this. If you only need this for a relatively modest range of years, a table-based approach may be most efficient. Say the table were in X2:Y29 with 2015 in X2, =X2+1 in X3, with X3 filled down into X4:X29, so 2015 to 2042. These years would begin on the last Saturday of the previous year, so for 2015, =DATE(X2,1,1)-WEEKDAY(DATE(X2,1,1)) in Y2. Fill Y2 down into Y3:Y29. Then name Y2:Y29 YBTable.

Given a date between the last Saturdays in 2014 and 2042, the week number for a date in cell Z99 would be given by

=1+INT((Z99-LOOKUP(Z99,YBTable))/7)

If you REALLY have to do this in a single formula,

=1+INT((Z99-

    IF(DATE(YEAR(Z99)+1,1,1)-WEEKDAY(DATE(YEAR(Z99)+1,1,1))<=Z99,

      DATE(YEAR(Z99)+1,1,1)-WEEKDAY(DATE(YEAR(Z99)+1,1,1)),

      DATE(YEAR(Z99),1,1)-WEEKDAY(DATE(YEAR(Z99),1,1))))

    /7)